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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 7 17:59:15 CEST 2010


Author: edd
Date: 2010-07-07 17:59:14 +0200 (Wed, 07 Jul 2010)
New Revision: 1827

Removed:
   pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R
Modified:
   pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R
Log:
moved RcppStringVector into RcppMatrix


Modified: pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R	2010-07-07 15:48:29 UTC (rev 1826)
+++ pkg/Rcpp/inst/unitTests/runit.RcppMatrix.R	2010-07-07 15:59:14 UTC (rev 1827)
@@ -128,8 +128,29 @@
 		            rs.add("p2",   m(1));
 	    			return rs.getReturnList();')
 
-                  )
+                  ,"RcppStringVector_classic"=list(
+                   signature(x="character"),
+                   'RcppStringVector s = RcppStringVector(x);
+		            RcppResultSet rs;
+		            rs.add("string", s);
+			        return rs.getReturnList();')
 
+                  ,"RcppStringVector_wrap"=list(
+                   signature(x="character"),
+                   'RcppStringVector s = RcppStringVector(x);
+			        return wrap(s);')
+
+                  ,"RcppStringVector_begin"=list(
+                   signature(x="character"),
+				   'RcppStringVector s = RcppStringVector(x);
+		            return wrap(*s.begin());')
+
+                  ,"RcppStringVector_end"=list(
+                   signature(x="character"),
+                   'RcppStringVector s = RcppStringVector(x);
+		            return wrap(s(s.size()-1));')
+                   )
+
         signatures <- lapply(f, "[[", 1L)
         bodies <- lapply(f, "[[", 2L)
         fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
@@ -215,4 +236,30 @@
 
 
 
+test.RcppStringVector.classic <- function() {
+    fun <- .Rcpp.RcppMatrix$RcppStringVector_classic
+    sv <- c("tic", "tac", "toe")
+    checkEquals(fun(sv), list(string=sv), msg = "RcppStringVector.classic")
+}
 
+test.RcppStringVector.wrap <- function() {
+    fun <- .Rcpp.RcppMatrix$RcppStringVector_wrap
+    sv <- c("tic", "tac", "toe")
+    checkEquals(fun(sv), sv, msg = "RcppStringVector.wrap")
+}
+
+test.RcppStringVector.begin <- function() {
+    fun <- .Rcpp.RcppMatrix$RcppStringVector_begin
+    sv <- c("tic", "tac", "toe")
+    checkEquals(fun(sv), sv[1], msg = "RcppStringVector.begin")
+}
+
+test.RcppStringVector.end <- function() {
+    fun <- .Rcpp.RcppMatrix$RcppStringVector_end
+    sv <- c("tic", "tac", "toe")
+    checkEquals(fun(sv), sv[3], msg = "RcppStringVector.begin")
+}
+
+
+
+

Deleted: pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R	2010-07-07 15:48:29 UTC (rev 1826)
+++ pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R	2010-07-07 15:59:14 UTC (rev 1827)
@@ -1,54 +0,0 @@
-#!/usr/bin/r -t
-#
-# Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of Rcpp.
-#
-# Rcpp is free software: you can redistribute it and/or modify it
-# under the terms of the GNU General Public License as published by
-# the Free Software Foundation, either version 2 of the License, or
-# (at your option) any later version.
-#
-# Rcpp is distributed in the hope that it will be useful, but
-# WITHOUT ANY WARRANTY; without even the implied warranty of
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-# GNU General Public License for more details.
-#
-# You should have received a copy of the GNU General Public License
-# along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
-
-test.RcppStringVector.classic <- function() {
-    src <- 'RcppStringVector s = RcppStringVector(sx);
-            RcppResultSet rs;
-            rs.add("string", s);
-	        return rs.getReturnList();';
-    fun <- cxxfunction(signature(sx="character"), src, plugin="Rcpp")
-    sv <- c("tic", "tac", "toe")
-    checkEquals(fun(sv), list(string=sv), msg = "RcppStringVector.classic")
-}
-
-test.RcppStringVector.wrap <- function() {
-    src <- 'RcppStringVector s = RcppStringVector(sx);
-	        return wrap(s);';
-    fun <- cxxfunction(signature(sx="character"), src, plugin="Rcpp")
-    sv <- c("tic", "tac", "toe")
-    checkEquals(fun(sv), sv, msg = "RcppStringVector.wrap")
-}
-
-test.RcppStringVector.begin <- function() {
-    src <- 'RcppStringVector s = RcppStringVector(sx);
-            return wrap(*s.begin());';
-    fun <- cxxfunction(signature(sx="character"), src, plugin="Rcpp")
-    sv <- c("tic", "tac", "toe")
-    checkEquals(fun(sv), sv[1], msg = "RcppStringVector.begin")
-}
-
-test.RcppStringVector.end <- function() {
-    src <- 'RcppStringVector s = RcppStringVector(sx);
-            return wrap(s(s.size()-1));';
-    fun <- cxxfunction(signature(sx="character"), src, plugin="Rcpp")
-    sv <- c("tic", "tac", "toe")
-    checkEquals(fun(sv), sv[3], msg = "RcppStringVector.begin")
-}
-
-



More information about the Rcpp-commits mailing list