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

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

Author: romain
Date: 2010-07-07 17:19:00 +0200 (Wed, 07 Jul 2010)
New Revision: 1824

Removed:
   pkg/Rcpp/inst/unitTests/runit.evaluator.R
   pkg/Rcpp/inst/unitTests/runit.exceptions.R
Modified:
   pkg/Rcpp/inst/unitTests/runit.misc.R
Log:
more groupiong

Deleted: pkg/Rcpp/inst/unitTests/runit.evaluator.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.evaluator.R	2010-07-07 15:13:28 UTC (rev 1823)
+++ pkg/Rcpp/inst/unitTests/runit.evaluator.R	2010-07-07 15:19:00 UTC (rev 1824)
@@ -1,36 +0,0 @@
-#!/usr/bin/r -t
-#
-# Copyright (C) 2009 - 2010	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.evaluator.error <- function(){
-	funx <- cppfunction(signature(),  '
-	return Rcpp::Evaluator::run( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) ) ;
-	' )
-	
-	checkException( funx(), msg = "Evaluator::run( stop() )" )
-}
-
-test.evaluator.ok <- function(){
-	funx <- cppfunction(signature(x="integer"),  '
-	return Rcpp::Evaluator::run( Rf_lang2( Rf_install("sample"), x ) ) ;
-	' )
-	
-	checkEquals( sort(funx(1:10)), 1:10, msg = "Evaluator running fine" )
-}
-             

Deleted: pkg/Rcpp/inst/unitTests/runit.exceptions.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.exceptions.R	2010-07-07 15:13:28 UTC (rev 1823)
+++ pkg/Rcpp/inst/unitTests/runit.exceptions.R	2010-07-07 15:19:00 UTC (rev 1824)
@@ -1,52 +0,0 @@
-#!/usr/bin/r -t
-#
-# Copyright (C) 2009 - 2010	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.exceptions <- function(){
-	can.demangle <- Rcpp:::capabilities()[["demangling"]]
-	
-	funx <- cppfunction(signature(), '
-	throw std::range_error("boom") ;
-	return R_NilValue ;
-	')
-	e <- tryCatch(  funx(), "C++Error" = function(e) e )
-	checkTrue( "C++Error" %in% class(e), msg = "exception class C++Error" )
-	
-	if( can.demangle ){
-		checkTrue( "std::range_error" %in% class(e), msg = "exception class std::range_error" )
-	}
-	checkEquals( e$message, "boom", msg = "exception message" )
-	
-	if( can.demangle ){
-		# same with direct handler
-		e <- tryCatch(  funx(), "std::range_error" = function(e) e )
-		checkTrue( "C++Error" %in% class(e), msg = "(direct handler) exception class C++Error" )
-		checkTrue( "std::range_error" %in% class(e), msg = "(direct handler) exception class std::range_error" )
-		checkEquals( e$message, "boom", msg = "(direct handler) exception message" )
-	}
-	f <- function(){
-		try( funx(), silent = TRUE)
-		"hello world" 
-	}
-	checkEquals( f(), "hello world", msg = "life continues after an exception" )
-	
-}
-
-
-
-

Modified: pkg/Rcpp/inst/unitTests/runit.misc.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.misc.R	2010-07-07 15:13:28 UTC (rev 1823)
+++ pkg/Rcpp/inst/unitTests/runit.misc.R	2010-07-07 15:19:00 UTC (rev 1824)
@@ -56,13 +56,30 @@
     			'
         	), 
         	"Dimension_const" = list( 
-        	signature( ia = "integer" ), 
-        	'
-			simple ss(ia);
-			return wrap(ss.nrow());
-			'
+        		signature( ia = "integer" ), 
+        		'
+				simple ss(ia);
+				return wrap(ss.nrow());
+				'
+        	), 
+        	"evaluator_error" = list( 
+        		signature(),  
+        		'
+				return Rcpp::Evaluator::run( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) ) ;
+				'
+        	), 
+        	"evaluator_ok" = list( 
+        		signature(x="integer"),  '
+				return Rcpp::Evaluator::run( Rf_lang2( Rf_install("sample"), x ) ) ;
+				'
+        	), 
+        	"exceptions_" = list( 
+        		signature(), '
+				throw std::range_error("boom") ;
+				return R_NilValue ;
+				'
         	)
-        )
+        )   
 
         signatures <- lapply(f, "[[", 1L)
         bodies <- lapply(f, "[[", 2L)
@@ -117,6 +134,45 @@
 	
 }
 
+test.evaluator.error <- function(){
+   funx <- .rcpp.misc$evaluator_error
+   checkException( funx(), msg = "Evaluator::run( stop() )" )
+}
+
+test.evaluator.ok <- function(){
+	funx <- .rcpp.misc$evaluator_ok
+	checkEquals( sort(funx(1:10)), 1:10, msg = "Evaluator running fine" )
+}
+       
+test.exceptions <- function(){
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	
+	funx <- .rcpp.misc$exceptions_
+	e <- tryCatch(  funx(), "C++Error" = function(e) e )
+	checkTrue( "C++Error" %in% class(e), msg = "exception class C++Error" )
+	
+	if( can.demangle ){
+		checkTrue( "std::range_error" %in% class(e), msg = "exception class std::range_error" )
+	}
+	checkEquals( e$message, "boom", msg = "exception message" )
+	
+	if( can.demangle ){
+		# same with direct handler
+		e <- tryCatch(  funx(), "std::range_error" = function(e) e )
+		checkTrue( "C++Error" %in% class(e), msg = "(direct handler) exception class C++Error" )
+		checkTrue( "std::range_error" %in% class(e), msg = "(direct handler) exception class std::range_error" )
+		checkEquals( e$message, "boom", msg = "(direct handler) exception message" )
+	}
+	f <- function(){
+		try( funx(), silent = TRUE)
+		"hello world" 
+	}
+	checkEquals( f(), "hello world", msg = "life continues after an exception" )
+	
+}
+
+
+
 test.has.iterator <- function(){
 	
 	classes <- c( "std::vector<int>", "std::list<int>", "std::deque<int>",