[Rcpp-commits] r1184 - in pkg/Rcpp/inst: include/Rcpp unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri May 7 09:15:46 CEST 2010


Author: romain
Date: 2010-05-07 09:15:46 +0200 (Fri, 07 May 2010)
New Revision: 1184

Added:
   pkg/Rcpp/inst/include/Rcpp/class_start.h
   pkg/Rcpp/inst/include/Rcpp/class_stop.h
Modified:
   pkg/Rcpp/inst/unitTests/runit.macros.R
Log:
testing RCPP_* macros

Added: pkg/Rcpp/inst/include/Rcpp/class_start.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/class_start.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/class_start.h	2010-05-07 07:15:46 UTC (rev 1184)
@@ -0,0 +1,34 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// class_start.h: Rcpp R/C++ interface class library -- preprocessor helpers
+//
+// 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/>.
+
+// no ifdef protection on purpose
+
+#undef RCPP_REGISTER 
+
+#ifndef RCPP_CLASS
+#error "the macro RCPP_CLASS must be defined to use the RCPP_CLASS_START"
+#else
+#define __RCPP__COLLECTOR RCPP_PP_CAT(rcpp__collector__, RCPP_CLASS)
+#define RCPP_METHOD(__METHOD__) RCPP_PP_CAT( RCPP_CLASS, RCPP_PP_CAT(__,__METHOD__ ))
+static std::vector<std::string> __RCPP__COLLECTOR ;
+#define RCPP_REGISTER(__NAME__) __RCPP__COLLECTOR.push_back( #__NAME__ ) ;
+#endif
+

Added: pkg/Rcpp/inst/include/Rcpp/class_stop.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/class_stop.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/class_stop.h	2010-05-07 07:15:46 UTC (rev 1184)
@@ -0,0 +1,39 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// class_stop.h: Rcpp R/C++ interface class library -- preprocessor helpers
+//
+// 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/>.
+
+// no ifdef protection on purpose
+
+#ifndef __RCPP__COLLECTOR
+#error "unpaired RCPP_CLASS_START/RCPP_CLASS_STOP"
+#else
+#undef __RCPP_BOOTSTRAP
+#define __RCPP_BOOTSTRAP RCPP_PP_CAT(__rcpp__class__bootstrap__,RCPP_CLASS)
+extern "C" __RCPP_BOOTSTRAP(){
+	return ::Rcpp::wrap( __RCPP__COLLECTOR ) ;	
+}
+#undef __RCPP_BOOTSTRAP
+#undef __RCPP__COLLECTOR
+#undef RCPP_CLASS
+#undef RCPP_REGISTER
+#undef RCPP_METHOD
+#define RCPP_REGISTER(__NAME__) 
+#endif
+

Modified: pkg/Rcpp/inst/unitTests/runit.macros.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.macros.R	2010-05-07 06:12:45 UTC (rev 1183)
+++ pkg/Rcpp/inst/unitTests/runit.macros.R	2010-05-07 07:15:46 UTC (rev 1184)
@@ -34,3 +34,81 @@
 	checkEquals( rcpp_typeof(""), sexp_types[["character"]], msg = "RCPP_RETURN_VECTOR <STRSXP> " )
 }
 
+test.RCPPFUNCTION <- function(){
+	
+	fx <- cppfunction( signature(), '
+		return foo() ;
+	', includes = '
+	RCPP_FUNCTION_0(int, foo){
+		return 10 ;
+	}
+	')
+	checkEquals( fx(), 10L, msg = "RCPP_FUNCTION_0" )
+	
+	fx <- cppfunction( signature(x = "numeric", y = "numeric" ), '
+		return foo(x, y) ;
+	', includes = '
+	RCPP_FUNCTION_2(double, foo, double x, double y){
+		return x * y ;
+	}
+	')
+	checkEquals( fx( 10, 10), 100, msg = "RCPP_FUNCTION_2" )
+	
+}
+
+test.RCPPFUNCTION.VOID <- function(){
+	fx <- cppfunction( signature(), '
+		return foo() ;
+	', includes = '
+	RCPP_FUNCTION_VOID_0(foo){
+		Rprintf("hello\\n") ;
+	}
+	')
+	checkEquals( capture.output( x <- fx() ) , "hello", 10L, msg = "RCPP_FUNCTION_VOID_0" )
+	
+	fx <- cppfunction( signature(x = "character", y = "integer" ), '
+		return foo(x, y) ;
+	', includes = '
+	RCPP_FUNCTION_VOID_2(foo, std::string x, int y){
+		Rprintf("hello %s (%d)\\n", x.c_str(), y) ;
+	}
+	')
+	checkEquals( capture.output( x <- fx("world", 3L) ) , "hello world (3)", 10L, msg = "RCPP_FUNCTION_VOID_0" )
+		
+}
+
+test.RCPPXPMETHOD <- function(){
+	
+	fx <- cppfunction( signature(), '
+		std::vector<int>* v = new std::vector<int>(5) ;
+		return XPtr< std::vector<int> >(v,true) ;
+	' )
+	xp <- fx()
+	
+	f_size <- cppfunction( signature( xp = "externalptr" ), '
+		return get_size( xp ) ;
+	', includes = '
+		RCPP_XP_METHOD_0( get_size, std::vector<int>, size )
+	' )
+	checkEquals( f_size(), 5L, msg = "RCPP_XP_METHOD_0" )
+	
+	f_push_back <- cppfunction( signature( xp = "externalptr", x = "integer" ), '
+		vec_push_back( xp, x );
+		return R_NilValue ;
+	', includes = '
+		RCPP_XP_METHOD_VOID_1( vec_push_back, std::vector<int>, push_back )
+	' )
+	f_push_back( xp, 10L )
+	f_push_back( xp, 20L )
+	checkEquals( f_size(xp), 7L, msg = "RCPP_XP_METHOD_0" )
+	
+	f_front_cast <- cppfunction( signature( xp = "externalptr" ), '
+		return front( xp ) ;
+	', includes = '
+		RCPP_XP_METHOD_CAST_0( front, std::vector<int>, front, double )
+	' )
+	checkEquals( f_front_cast(xp), 0, msg = "RCPP_XP_METHOD_CAST value" )
+	checkEquals( typeof( f_front_cast(xp) ), "double", msg = "RCPP_XP_METHOD_CAST type" )
+}
+
+



More information about the Rcpp-commits mailing list