[Rcpp-commits] r619 - in pkg/inst: . unitTests

[noreply at r-forge.r-project.org]

Author: edd
Date: 2010-02-07 02:37:40 +0100 (Sun, 07 Feb 2010)
New Revision: 619

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.RcppMatrix.R
   pkg/inst/unitTests/runit.RcppVector.R
Log:
new unit test based on email by Leo Alekseyev


Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-02-07 00:43:35 UTC (rev 618)
+++ pkg/inst/ChangeLog	2010-02-07 01:37:40 UTC (rev 619)
@@ -4,6 +4,9 @@
 	  version using the new API
 	* inst/examples/functionCallback/newApiExamples.r: Updated
 
+	* inst/unitTests/runit.RcppVector.R: added test for NA/NaN
+	* inst/unitTests/runit.RcppMatrix.R: idem
+
 2010-02-06  Romain Francois <francoisromain at free.fr>
 
 	* src/Rcpp/RObject.h : asFoo methods are deprecated.

Modified: pkg/inst/unitTests/runit.RcppMatrix.R
===================================================================
--- pkg/inst/unitTests/runit.RcppMatrix.R	2010-02-07 00:43:35 UTC (rev 618)
+++ pkg/inst/unitTests/runit.RcppMatrix.R	2010-02-07 01:37:40 UTC (rev 619)
@@ -55,6 +55,22 @@
                      msg = "RcppMatrix.double")
 }
 
+test.RcppMatrix.double.na.nan <- function() {
+    src <- 'RcppMatrix<double> m(x);
+            RcppResultSet rs;
+            rs.add("na_21",  R_IsNA(m(1,0)));
+            rs.add("na_22",  R_IsNA(m(1,1)));
+            rs.add("nan_31", R_IsNaN(m(2,0)));
+            rs.add("nan_32", R_IsNaN(m(2,1)));
+	    return rs.getReturnList();';
+    funx <- cfunction(signature(x="numeric"), src, Rcpp=TRUE)
+    M <- matrix(1:6,3,2,byrow=TRUE)
+    M[2,1] <- NA
+    M[3,1] <- NaN
+    checkEquals(funx(x=M),
+                list(na_21=1, na_22=0, nan_31=1, nan_32=0),
+                msg = "RcppMatrix.double.na.nan")
+}
 
 
 
@@ -69,3 +85,4 @@
 
 
 
+

Modified: pkg/inst/unitTests/runit.RcppVector.R
===================================================================
--- pkg/inst/unitTests/runit.RcppVector.R	2010-02-07 00:43:35 UTC (rev 618)
+++ pkg/inst/unitTests/runit.RcppVector.R	2010-02-07 01:37:40 UTC (rev 619)
@@ -45,6 +45,22 @@
     checkEquals(funx(x=c(1:6)), list(size=6, p2=2, v=c(1:6)), msg="RcppVector.double")
 }
 
+test.RcppVector.double.na.nan <- function() {
+    src <- 'RcppVector<double> m(x);
+            RcppResultSet rs;
+            rs.add("na_2",  R_IsNA(m(1)));
+            rs.add("na_3",  R_IsNA(m(2)));
+            rs.add("nan_4", R_IsNaN(m(3)));
+            rs.add("nan_5", R_IsNaN(m(4)));
+	    return rs.getReturnList();';
+    funx <- cfunction(signature(x="numeric"), src, Rcpp=TRUE)
+    x <- 1:6
+    x[2] <- NA
+    x[4] <- NaN
+    checkEquals(funx(x=x),
+                list(na_2=1, na_3=0, nan_4=1, nan_5=0),
+                msg = "RcppMatrix.double.na.nan")
+}
 
 
 
@@ -59,3 +75,4 @@
 
 
 
+