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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Jul 2 15:52:02 CEST 2010


Author: edd
Date: 2010-07-02 15:52:02 +0200 (Fri, 02 Jul 2010)
New Revision: 1765

Added:
   pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R
Log:
new test for RcppStringVector


Added: pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R	2010-07-02 13:52:02 UTC (rev 1765)
@@ -0,0 +1,54 @@
+#!/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")
+}
+
+


Property changes on: pkg/Rcpp/inst/unitTests/runit.RcppStringVector.R
___________________________________________________________________
Added: svn:executable
   + *
Added: svn:eol-style
   + native



More information about the Rcpp-commits mailing list