Make merge.xts error if index contains NA

There were cases where merge.xts would not throw an error if the index
contained NA values.

One case was if the index was integer, because the section of code that
checked for integer NA was referencing the real_*index references
instead of int_*index.

After fixing that bug, the issue still remained for integer indexes.
Now the issue is that NA_INTEGER = INT_MIN, so logical operations still
work. But they don't give the results we want. Fix the issue by
checking for NA_INTEGER before any other logical comparisons.

Added similar checks for the real/double index case as well, and also
moved the check to the top of the if/else branch. Note that the test
now uses R_FINITE to check for NaN and +/-Inf as well.

I really do not like these checks in the first position of the if/else
branch because they should never happen in user space. For performance,
the most commonly true if statements should come first. Need to look
for an upstream place to check for NA in the index.

Fixes #174.

inst/unitTests/runit.merge.R

@@ -4,3 +4,51 @@ test.merge_empty_xts_with_2_scalars <- function() {
   checkIdentical(m1, m2)
 }
 
+# Tests for NA in index. Construct xts object using structure() because
+# xts constructors should not allow users to create objects with NA in
+# the index
+indexHasNA_dbl <-
+structure(1:5, .Dim = c(5L, 1L),
+          index = structure(c(1, 2, 3, 4, NA), tzone = "",
+                            tclass = c("POSIXct", "POSIXt")),
+          .indexCLASS = c("POSIXct", "POSIXt"),
+          .indexTZ = "", tclass = c("POSIXct", "POSIXt"),
+          tzone = "", class = c("xts", "zoo"))
+
+indexHasNA_int <-
+structure(1:5, .Dim = c(5L, 1L),
+          index = structure(c(1L, 2L, 3L, 4L, NA), tzone = "",
+                            tclass = c("POSIXct", "POSIXt")),
+          .indexCLASS = c("POSIXct", "POSIXt"),
+          .indexTZ = "", tclass = c("POSIXct", "POSIXt"),
+          tzone = "", class = c("xts", "zoo"))
+
+test.merge_index_contains_NA_integer <- function() {
+  checkException(merge(indexHasNA_int, indexHasNA_int), silent = TRUE)
+}
+
+test.merge_index_contains_NA_double <- function() {
+  checkException(merge(indexHasNA_dbl, indexHasNA_dbl), silent = TRUE)
+}
+
+test.merge_index_contains_NaN <- function() {
+  x <- indexHasNA_dbl
+  idx <- attr(x, "index")
+  idx[length(idx)] <- NaN
+  attr(x, "index") <- idx
+  checkException(merge(x, x), silent = TRUE)
+}
+
+test.merge_index_contains_Inf <- function() {
+  x <- indexHasNA_dbl
+  idx <- attr(x, "index")
+  idx[length(idx)] <- Inf
+  attr(x, "index") <- idx
+  checkException(merge(x, x), silent = TRUE)
+
+  idx <- rev(idx)
+  idx[1L] <- -Inf
+  attr(x, "index") <- idx
+  checkException(merge(x, x), silent = TRUE)
+}
+# /end Tests for NA in index

src/merge.c

@@ -156,6 +156,9 @@ SEXP do_merge_xts (SEXP x, SEXP y,
   real_xindex = REAL(xindex);
   real_yindex = REAL(yindex);
   while( (xp + yp) <= (len + 1) ) {
+    if(!R_FINITE(real_xindex[ xp-1 ]) || !R_FINITE(real_yindex[ yp-1 ])) {
+      error("'index' cannot contain 'NA', 'NaN', or 'Inf'");
+    } else
     if( xp > nrx ) {
       yp++;
       if(right_join) i++;
@@ -179,17 +182,17 @@ SEXP do_merge_xts (SEXP x, SEXP y,
       /* RIGHT JOIN */
       yp++;
       if(right_join) i++;
-    } else
-    if(ISNA(real_xindex[ xp-1 ]) || ISNA(real_yindex[ yp-1 ])) {
-Rprintf("%f, %f\n",real_xindex[xp-1],real_yindex[yp-1]);
-      error("'NA' not allowed in 'index'");
     }
   } 
   } else
   if( TYPEOF(xindex) == INTSXP ) {
   int_xindex = INTEGER(xindex);
   int_yindex = INTEGER(yindex);
   while( (xp + yp) <= (len + 1) ) {
+    /* Check for NA first; logical ops on them may yield surprising results */
+    if(int_xindex[ xp-1 ]==NA_INTEGER || int_yindex[ yp-1 ]==NA_INTEGER) {
+       error("'index' cannot contain 'NA'");
+    } else
     if( xp > nrx ) {
       yp++;
       if(right_join) i++;
@@ -210,10 +213,6 @@ Rprintf("%f, %f\n",real_xindex[xp-1],real_yindex[yp-1]);
     if( int_xindex[ xp-1 ] > int_yindex[ yp-1 ] ) {
       yp++;
       if(right_join) i++;
-    } else
-    if(real_xindex[ xp-1 ]==NA_INTEGER ||
-       real_yindex[ yp-1 ]==NA_INTEGER) {
-       error("'NA' not allowed in 'index'");
     }
   } 
   }