stop trying to be clever and just be portable

Author: kevinushey

inst/include/Rcpp/sugar/tools/mapcompare.h

@@ -22,19 +22,9 @@
 #ifndef Rcpp__sugar__tools__mapcompare_h
 #define Rcpp__sugar__tools__mapcompare_h
 
-#define R_UNSIGNED_LONG_NAN_REAL 0x7ff8000000000000
-
 namespace Rcpp {
 namespace sugar {
 
-inline bool Rcpp_IsNA(double x) {
-  return *reinterpret_cast<unsigned long*>(&x) == *reinterpret_cast<unsigned long*>(&NA_REAL);
-}
-
-inline bool Rcpp_IsNaN(double x) {
-  return *reinterpret_cast<unsigned long*>(&x) == R_UNSIGNED_LONG_NAN_REAL;
-}
-
 inline int StrCmp(SEXP x, SEXP y) {
     if (x == NA_STRING) return (y == NA_STRING ? 0 : 1);
     if (y == NA_STRING) return -1;
@@ -67,7 +57,7 @@ struct MapCompare<double> {
 
     // this branch inspired by data.table: see
     // https://github.com/arunsrinivasan/datatable/commit/1a3e476d3f746e18261662f484d2afa84ac7a146#commitcomment-4885242
-    if (Rcpp_IsNaN(right) and Rcpp_IsNA(left)) return true;
+    if (R_IsNaN(right) and R_IsNA(left)) return true;
 
     if (leftNaN != rightNaN) {
       return leftNaN < rightNaN;

inst/unitTests/runit.table.R

@@ -21,30 +21,28 @@
 
 if (.runThisTest) {
 
-  set.seed(123)
-  
   .setUp <- Rcpp:::unit_test_setup("table.cpp")
 
-  table <- function(x) base::table(x, useNA="ifany")
+  table_ <- function(x) c(base::table(x, useNA="ifany"))
 
   test.table.numeric <- function() {
-    x <- c(1, 2, NA, NaN, -Inf, Inf)
-    checkEquals( RcppTable(x), c(table(x)), "table matches R: numeric case")
+    x <- c(1, 2, 1, 1, NA, NaN, -Inf, Inf)
+    checkEquals( RcppTable(x), table_(x), "table matches R: numeric case")
   }
 
   test.table.integer <- function() {
     x <- c(-1L, 1L, NA_integer_, NA_integer_, 100L, 1L)
-    checkEquals( RcppTable(x), c(table(x)), "table matches R: integer case")
+    checkEquals( RcppTable(x), table_(x), "table matches R: integer case")
   }
 
   test.table.logical <- function() {
     x <- c(TRUE, TRUE, FALSE, NA)
-    checkEquals( RcppTable(x), c(table(x)), "table matches R: logical case")
+    checkEquals( RcppTable(x), table_(x), "table matches R: logical case")
   }
 
   test.table.character <- function() {
     x <- c("a", "a", "b", "a", NA, NA)
-    checkEquals( RcppTable(x), c(table(x)), "table matches R: character case")
+    checkEquals( RcppTable(x), table_(x), "table matches R: character case")
   }
 
 }