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

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

Author: romain
Date: 2010-05-07 13:30:32 +0200 (Fri, 07 May 2010)
New Revision: 1186

Modified:
   pkg/Rcpp/inst/unitTests/runit.macros.R
Log:
more testing for the generated pseudo reflection information

Modified: pkg/Rcpp/inst/unitTests/runit.macros.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.macros.R	2010-05-07 07:28:22 UTC (rev 1185)
+++ pkg/Rcpp/inst/unitTests/runit.macros.R	2010-05-07 11:30:32 UTC (rev 1186)
@@ -17,6 +17,21 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+.getInfo <- function( symbol, fx ){
+	env <- environment( fx at .Data )
+	f <- get( "f", env )
+	dlls <- getLoadedDLLs()
+	dll <- if( ! f %in% names(dlls) ){
+		dyn.load( get( "libLFile", env ) )
+	} else{
+		dlls[[ match( f, names(dlls) ) ]]
+	}
+	info_symbol <- paste( symbol, "__rcpp_info__", sep = "" )
+	routine <- getNativeSymbolInfo( info_symbol, dll )
+	info <- .Call( routine )
+	info
+}
+
 test.macro.switch <- function(){
 	rcpp_typeof <- function(x){
 		.Call( "rcpp_call_test", x, PACKAGE = "Rcpp" )
@@ -45,9 +60,7 @@
 	')
 	checkEquals( fx(), 10L, msg = "RCPP_FUNCTION_0" )
 	
-	dll <- tail( getLoadedDLLs(), 1 )
-	info <- .Call( dll[[ length(dll) ]]$foo__rcpp_info__ )
-	checkEquals( info, 
+	checkEquals( .getInfo( "foo", fx ) , 
 		structure( list( 
 		n = 0L, 
 		output = "int", 
@@ -62,6 +75,12 @@
 	')
 	checkEquals( fx( 10, 10), 100, msg = "RCPP_FUNCTION_2" )
 	
+	checkEquals( .getInfo( "foo", fx ) , 
+		structure( list( 
+		n = 2L, 
+		output = "double", 
+		input = c("double x","double y") ), class = "rcppfunctioninfo" ) )
+	
 }
 
 test.RCPPFUNCTION.VOID <- function(){
@@ -74,6 +93,12 @@
 	')
 	checkEquals( capture.output( x <- fx() ) , "hello", 10L, msg = "RCPP_FUNCTION_VOID_0" )
 	
+	info <- .getInfo( "foo", fx )
+	checkEquals( info[["n"]], 0L )
+	checkEquals( info[["input"]], character(0) )
+	checkEquals( info[["output"]], NULL) 
+	checkEquals( class(info), "rcppfunctionvoidinfo" )
+	
 	fx <- cppfunction( signature(x = "character", y = "integer" ), '
 		return foo(x, y) ;
 	', includes = '
@@ -82,6 +107,12 @@
 	}
 	')
 	checkEquals( capture.output( x <- fx("world", 3L) ) , "hello world (3)", 10L, msg = "RCPP_FUNCTION_VOID_0" )
+	
+	info <- .getInfo( "foo", fx )
+	checkEquals( info[["n"]], 2L )
+	checkEquals( info[["input"]], c("std::string x","int y") )
+	checkEquals( info[["output"]], NULL) 
+	checkEquals( class(info), "rcppfunctionvoidinfo" )
 		
 }
 
@@ -98,8 +129,15 @@
 	', includes = '
 		RCPP_XP_METHOD_0( get_size, std::vector<int>, size )
 	' )
-	checkEquals( f_size(), 5L, msg = "RCPP_XP_METHOD_0" )
+	checkEquals( f_size(xp), 5L, msg = "RCPP_XP_METHOD_0" )
 	
+	info <- .getInfo( "get_size", f_size )
+	checkEquals( info[["n"]], 0L )
+	checkEquals( info[["class"]], "std::vector<int>" )
+	checkEquals( info[["method"]], "size") 
+	checkEquals( class(info), "rcppxpmethodinfo" )
+	
+	
 	f_push_back <- cppfunction( signature( xp = "externalptr", x = "integer" ), '
 		vec_push_back( xp, x );
 		return R_NilValue ;
@@ -110,6 +148,13 @@
 	f_push_back( xp, 20L )
 	checkEquals( f_size(xp), 7L, msg = "RCPP_XP_METHOD_0" )
 	
+	info <- .getInfo( "vec_push_back", f_push_back )
+	checkEquals( info[["n"]], 1L )
+	checkEquals( info[["class"]], "std::vector<int>" )
+	checkEquals( info[["method"]], "push_back") 
+	checkEquals( class(info), "rcppxpmethodvoidinfo" )
+	
+	
 	f_front_cast <- cppfunction( signature( xp = "externalptr" ), '
 		return front( xp ) ;
 	', includes = '
@@ -117,6 +162,15 @@
 	' )
 	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" )
+	
+	info <- .getInfo( "front", f_front_cast )
+	checkEquals( info[["n"]], 0L )
+	checkEquals( info[["class"]], "std::vector<int>" )
+	checkEquals( info[["method"]], "front") 
+	checkEquals( info[["cast"]], "double") 
+	
+	checkEquals( class(info), "rcppxpmethodcastinfo" )
+	
 }