[Rcpp-commits] r1698 - pkg/Rcpp/inst/unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 24 02:07:52 CEST 2010


Author: edd
Date: 2010-06-24 02:07:52 +0200 (Thu, 24 Jun 2010)
New Revision: 1698

Modified:
   pkg/Rcpp/inst/unitTests/runit.Date.R
Log:
added test for operators


Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R	2010-06-23 23:24:28 UTC (rev 1697)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R	2010-06-24 00:07:52 UTC (rev 1698)
@@ -18,22 +18,22 @@
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 test.Date.ctor.mdy <- function() {
-    src <- 'Rcpp::Date dt = Rcpp::Date(12,31,2005);
-	    return Rcpp::wrap(dt);';
+    src <- 'Date dt = Date(12,31,2005);
+	    return wrap(dt);'
     fun <- cxxfunction(signature(), src, plugin = "Rcpp" )
     checkEquals(fun(), as.Date("2005-12-31"), msg = "Date.ctor.mdy")
 }
 
 test.Date.ctor.ymd <- function() {
-    src <- 'Rcpp::Date dt = Rcpp::Date(2005,12,31);
-	    return Rcpp::wrap(dt);';
+    src <- 'Date dt = Date(2005,12,31);
+	    return wrap(dt);'
     fun <- cxxfunction(signature(), src, plugin = "Rcpp" )
     checkEquals(fun(), as.Date("2005-12-31"), msg = "Date.ctor.ymd")
 }
 
 test.Date.ctor.int <- function() {
-    src <- 'Rcpp::Date dt = Rcpp::Date(Rcpp::as<int>(d));
-	    return Rcpp::wrap(dt);';
+    src <- 'Date dt = Date(Rcpp::as<int>(d));
+	    return wrap(dt);'
     fun <- cxxfunction(signature(d="numeric"), src, plugin = "Rcpp")
     d <- as.Date("2005-12-31")
     checkEquals(fun(as.numeric(d)), d, msg = "Date.ctor.int")
@@ -41,6 +41,22 @@
     checkException(fun("foo"), msg = "Date.ctor -> exception" )
 }
 
+test.Date.operators <- function() {
+    src <- 'Date d1 = Date(2005,12,31);
+            Date d2 = d1 + 1;
+            return List::create(Named("diff") = d2 - d1,
+                                Named("bigger") = d2 > d1,
+                                Named("smaller") = d2 < d1,
+                                Named("equal") = d2 == d1,
+                                Named("ge") = d2 >= d1,
+                                Named("le") = d2 <= d1,
+                                Named("ne") = d2 != d1);'
+    fun <- cxxfunction(signature(), src, plugin="Rcpp")
+    checkEquals(fun(),
+                list(diff=-1, bigger=TRUE, smaller=FALSE, equal=FALSE, ge=TRUE, le=FALSE, ne=TRUE),
+                msg = "Date.operators")
+}
+
 test.vector.Date <- function(){
 	fx <- cxxfunction( , '
 		std::vector<Date> v(2) ;
@@ -48,26 +64,26 @@
 		v[1] = Date(12,31,2005) ;
 		return wrap( v ) ;
 	', plugin = "Rcpp" )
-    checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "Date.vector")
+    checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "Date.vector.wrap")
 }
 
-test.vector.DateVector <- function(){
+test.DateVector.wrap <- function(){
 	fx <- cxxfunction( , '
 		DateVector v(2) ;
 		v[0] = Date(2005,12,31) ;
 		v[1] = Date(12,31,2005) ;
 		return wrap( v ) ;
 	', plugin = "Rcpp" )
-    checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "Date.vector")
+    checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "DateVector.wrap")
 }
 
-test.vector.operator.SEXP <- function(){
+test.DateVector.operator.SEXP <- function(){
 	fx <- cxxfunction( , '
 		DateVector v(2) ;
 		v[0] = Date(2005,12,31) ;
 		v[1] = Date(12,31,2005) ;
 		return v ;
 	', plugin = "Rcpp" )
-    checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "Date.vector")
+    checkEquals(fx(), rep(as.Date("2005-12-31"),2), msg = "DateVector.SEXP")
 }
 



More information about the Rcpp-commits mailing list