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

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

Author: romain
Date: 2010-06-09 10:10:57 +0200 (Wed, 09 Jun 2010)
New Revision: 1500

Modified:
   pkg/Rcpp/inst/include/Rcpp/config.h
   pkg/Rcpp/inst/unitTests/runit.environments.R
   pkg/Rcpp/inst/unitTests/runit.exceptions.R
   pkg/Rcpp/src/RcppCommon.cpp
   pkg/Rcpp/src/exceptions.cpp
Log:
query the 'demangling' capability

Modified: pkg/Rcpp/inst/include/Rcpp/config.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/config.h	2010-06-09 07:58:25 UTC (rev 1499)
+++ pkg/Rcpp/inst/include/Rcpp/config.h	2010-06-09 08:10:57 UTC (rev 1500)
@@ -25,5 +25,10 @@
 // comment to disable Rcpp modules
 #define RCPP_ENABLE_MODULES
 
+#ifdef __GNUC__
+#define RCPP_HAS_DEMANGLING
 #endif
 
+
+#endif
+

Modified: pkg/Rcpp/inst/unitTests/runit.environments.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.environments.R	2010-06-09 07:58:25 UTC (rev 1499)
+++ pkg/Rcpp/inst/unitTests/runit.environments.R	2010-06-09 08:10:57 UTC (rev 1500)
@@ -91,10 +91,17 @@
 	checkEquals( e$b, Rcpp:::CxxFlags, msg = "Environment::assign, checking value 2" )
 	
 	lockBinding( "a", e )
-	checkTrue( 
-		tryCatch( { funx(e, "a", letters ) ; FALSE}, "Rcpp::binding_is_locked" = function(e) TRUE ), 
-		msg = "cannot assign to locked binding (catch exception)" )
-
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	if( can.demangle ){
+		checkTrue( 
+			tryCatch( { funx(e, "a", letters ) ; FALSE}, "Rcpp::binding_is_locked" = function(e) TRUE ), 
+			msg = "cannot assign to locked binding (catch exception)" )
+	} else {
+		checkTrue( 
+			tryCatch( { funx(e, "a", letters ) ; FALSE}, "error" = function(e) TRUE ), 
+			msg = "cannot assign to locked binding (catch exception)" )
+	}
+	
 }
 
 test.environment.isLocked <- function(){
@@ -132,10 +139,17 @@
 
 	checkTrue( !funx(e, "a" ), msg = "Environment::bindingIsActive( non active ) -> false" )
 	checkTrue( funx(e, "b" ), msg = "Environment::bindingIsActive( active ) -> true" )
-	checkTrue( 
-		tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
-		msg = "Environment::bindingIsActive(no binding) -> exception)" )
-	
+
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	if( can.demangle ){
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
+			msg = "Environment::bindingIsActive(no binding) -> exception)" )
+	} else {
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ), 
+			msg = "Environment::bindingIsActive(no binding) -> exception)" )
+	}
 }
 
 test.environment.bindingIsLocked <- function(){
@@ -153,10 +167,17 @@
 	
 	checkTrue( !funx(e, "a" ), msg = "Environment::bindingIsActive( non active ) -> false" )
 	checkTrue( funx(e, "b" ), msg = "Environment::bindingIsActive( active ) -> true" )
-	checkTrue( 
-		tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
-		msg = "Environment::bindingIsLocked(no binding) -> exception)" )
-	
+
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	if( can.demangle ){
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
+			msg = "Environment::bindingIsLocked(no binding) -> exception)" )
+	} else {
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ), 
+			msg = "Environment::bindingIsLocked(no binding) -> exception)" )
+	}
 }
 
 test.environment.NotAnEnvironment <- function(){
@@ -180,10 +201,17 @@
 	e$b <- letters
 	funx(e, "b")
 	checkTrue( bindingIsLocked("b", e ), msg = "Environment::lockBinding()" )
-	checkTrue( 
-		tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
-		msg = "Environment::lockBinding(no binding) -> exception)" )
-	
+
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	if( can.demangle ){
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
+			msg = "Environment::lockBinding(no binding) -> exception)" )
+	} else {
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ), 
+			msg = "Environment::lockBinding(no binding) -> exception)" )
+	}
 }
 
 test.environment.unlockBinding <- function(){
@@ -200,10 +228,17 @@
 	lockBinding( "b", e )
 	funx(e, "b")
 	checkTrue( !bindingIsLocked("b", e ), msg = "Environment::lockBinding()" )
-	checkTrue( 
-		tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
-		msg = "Environment::unlockBinding(no binding) -> exception)" )
-	
+
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	if( can.demangle ){
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, "Rcpp::no_such_binding" = function(e) TRUE ), 
+			msg = "Environment::unlockBinding(no binding) -> exception)" )
+	}Êelse {
+		checkTrue( 
+			tryCatch( { funx(e, "xx" ) ; FALSE}, error = function(e) TRUE ), 
+			msg = "Environment::unlockBinding(no binding) -> exception)" )
+	}
 }
 
 test.environment.global.env <- function(){
@@ -235,10 +270,17 @@
 	std::string st = as<std::string>(env) ;
 	return Environment::namespace_env(st); ' )
 	checkEquals( funx("Rcpp"), asNamespace("Rcpp"), msg = "REnvironment::base_namespace" )
-	checkTrue( 
-		tryCatch( { funx("----" ) ; FALSE}, "Rcpp::no_such_namespace" = function(e) TRUE ), 
-		msg = "Environment::namespace_env(no namespace) -> exception)" )
-	
+
+	can.demangle <- Rcpp:::capabilities()[["demangling"]]
+	if( can.demangle ){
+		checkTrue( 
+			tryCatch( { funx("----" ) ; FALSE}, "Rcpp::no_such_namespace" = function(e) TRUE ), 
+			msg = "Environment::namespace_env(no namespace) -> exception)" )
+	}Êelse {
+		checkTrue( 
+			tryCatch( { funx("----" ) ; FALSE}, error = function(e) TRUE ), 
+			msg = "Environment::namespace_env(no namespace) -> exception)" )
+	}
 }
 
 test.environment.constructor.SEXP <- function(){

Modified: pkg/Rcpp/inst/unitTests/runit.exceptions.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.exceptions.R	2010-06-09 07:58:25 UTC (rev 1499)
+++ pkg/Rcpp/inst/unitTests/runit.exceptions.R	2010-06-09 08:10:57 UTC (rev 1500)
@@ -18,21 +18,27 @@
 # 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" )
-	checkTrue( "std::range_error" %in% class(e), msg = "exception class std::range_error" )
+	
+	if( can.demangle ){
+		checkTrue( "std::range_error" %in% class(e), msg = "exception class std::range_error" )
+	}
 	checkEquals( e$message, "boom", msg = "exception message" )
 	
-	# 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" )
-	
+	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" 

Modified: pkg/Rcpp/src/RcppCommon.cpp
===================================================================
--- pkg/Rcpp/src/RcppCommon.cpp	2010-06-09 07:58:25 UTC (rev 1499)
+++ pkg/Rcpp/src/RcppCommon.cpp	2010-06-09 08:10:57 UTC (rev 1500)
@@ -76,7 +76,7 @@
 	LOGICAL(cap)[5] = FALSE ;
 #endif
 
-#ifdef __GNUC__
+#ifdef RCPP_HAS_DEMANGLING
 	LOGICAL(cap)[6] = TRUE ;
 #else
 	LOGICAL(cap)[6] = FALSE ;

Modified: pkg/Rcpp/src/exceptions.cpp
===================================================================
--- pkg/Rcpp/src/exceptions.cpp	2010-06-09 07:58:25 UTC (rev 1499)
+++ pkg/Rcpp/src/exceptions.cpp	2010-06-09 08:10:57 UTC (rev 1500)
@@ -62,7 +62,7 @@
 /* for now, the fancy exception handling is only available in GCC, 
    simply because we've not investigated if it is available in other 
    compilers */
-#ifdef __GNUC__
+#ifdef RCPP_HAS_DEMANGLING
 #include <typeinfo>
 #include <exception_defines.h>
 #include <cxxabi.h>