[Rcpp-commits] r215 - in pkg: R inst inst/examples/RcppInline src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Dec 27 18:15:21 CET 2009
Author: romain
Date: 2009-12-27 18:15:20 +0100 (Sun, 27 Dec 2009)
New Revision: 215
Added:
pkg/R/exceptions.R
pkg/R/zzz.R
pkg/inst/examples/RcppInline/UncaughtExceptions.r
Modified:
pkg/inst/ChangeLog
pkg/inst/examples/RcppInline/RcppSexpTests.r
pkg/src/RcppCommon.cpp
pkg/src/RcppCommon.h
pkg/src/RcppSexp.cpp
pkg/src/RcppSexp.h
Log:
added experimental uncaught exception handling
Added: pkg/R/exceptions.R
===================================================================
--- pkg/R/exceptions.R (rev 0)
+++ pkg/R/exceptions.R 2009-12-27 17:15:20 UTC (rev 215)
@@ -0,0 +1,28 @@
+# Copyright (C) 2009 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/>.
+
+uncaught_cpp_exception <- function( message = "uncaught C++ exception" ){
+ callstack <- sys.calls()
+ ncalls <- length(callstack)
+ call <- if( ncalls > 1L) callstack[[ ncalls - 1L ]] else match.call()
+ classes <- c( "C++Error", "error", "condition" )
+ condition <- structure(
+ list( message = message, call = call ),
+ class = classes )
+ stop( condition )
+}
+
Added: pkg/R/zzz.R
===================================================================
--- pkg/R/zzz.R (rev 0)
+++ pkg/R/zzz.R 2009-12-27 17:15:20 UTC (rev 215)
@@ -0,0 +1,20 @@
+# Copyright (C) 2009 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/>.
+
+.onAttach <- function(libname, pkgname){
+ .Call( "initUncaughtExceptionHandler", PACKAGE = pkgname )
+}
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2009-12-27 16:23:08 UTC (rev 214)
+++ pkg/inst/ChangeLog 2009-12-27 17:15:20 UTC (rev 215)
@@ -1,5 +1,14 @@
2009-12-27 Romain Francois <francoisromain at free.fr>
+ * src/RcppCommon.{h,cpp} : added experimental uncaught exception
+ management
+
+ * R/zzz.R : added .onAttach, used to register the uncaught exception
+ management on package attach
+
+ * R/exceptions.R : added R side of the exception management, unexported
+ as it is only used by internal C++ code
+
* src/RcppSexp.{h,cpp} : added method isNULL to test if the
underlying SEXP is NULL
Modified: pkg/inst/examples/RcppInline/RcppSexpTests.r
===================================================================
--- pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-27 16:23:08 UTC (rev 214)
+++ pkg/inst/examples/RcppInline/RcppSexpTests.r 2009-12-27 17:15:20 UTC (rev 215)
@@ -1,4 +1,22 @@
#!/usr/bin/r -t
+#
+# Copyright (C) 2009 Dirk Eddelbuettel
+# Copyright (C) 2009 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/>.
suppressMessages(library(Rcpp))
Added: pkg/inst/examples/RcppInline/UncaughtExceptions.r
===================================================================
--- pkg/inst/examples/RcppInline/UncaughtExceptions.r (rev 0)
+++ pkg/inst/examples/RcppInline/UncaughtExceptions.r 2009-12-27 17:15:20 UTC (rev 215)
@@ -0,0 +1,30 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2009 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/>.
+
+require( Rcpp)
+funx <- cfunction(signature(), '
+throw std::range_error("boom") ;
+return R_NilValue ;
+', Rcpp=TRUE, verbose=FALSE)
+tryCatch( funx(), "C++Error" = function(e){
+ print( "gotcha" )
+} )
+print( rnorm(10) )
+
+
Modified: pkg/src/RcppCommon.cpp
===================================================================
--- pkg/src/RcppCommon.cpp 2009-12-27 16:23:08 UTC (rev 214)
+++ pkg/src/RcppCommon.cpp 2009-12-27 17:15:20 UTC (rev 215)
@@ -39,3 +39,19 @@
inline void logTxtFunction(const char* file, const int line, const char* expression) {
Rprintf("%s:%d %s\n", file, line, expression);
}
+
+void forward_uncaught_exceptions_to_r(){
+ /* we don't bother unprotecting */
+ SEXP m = PROTECT( Rf_mkString( "uncaught C++ exception" ) ) ;
+ SEXP call = PROTECT( Rf_lang2( Rf_install("uncaught_cpp_exception"), m ) ) ;
+ Rf_eval( call, R_FindNamespace(Rf_mkString("Rcpp")) ) ;
+
+ /* but this is never actually called since the call eventually calls stop */
+ UNPROTECT(1);
+}
+SEXP initUncaughtExceptionHandler(){
+ void (*old_terminate)() = std::set_terminate(forward_uncaught_exceptions_to_r);
+ return R_NilValue ;
+}
+
+
Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h 2009-12-27 16:23:08 UTC (rev 214)
+++ pkg/src/RcppCommon.h 2009-12-27 17:15:20 UTC (rev 215)
@@ -4,6 +4,7 @@
//
// Copyright (C) 2005 - 2006 Dominick Samperi
// Copyright (C) 2008 - 2009 Dirk Eddelbuettel
+// Copyright (C) 2009 Romain Francois
//
// This file is part of Rcpp.
//
@@ -23,6 +24,7 @@
#ifndef RcppCommon_h
#define RcppCommon_h
+#include <exception>
#include <iostream>
#include <sstream>
#include <string>
@@ -51,4 +53,7 @@
//#define logTxt(x) logTxtFunction(__FILE__, __LINE__, x);
#define logTxt(x)
+void forward_uncaught_exceptions_to_r() ;
+RcppExport SEXP initUncaughtExceptionHandler() ;
+
#endif
Modified: pkg/src/RcppSexp.cpp
===================================================================
--- pkg/src/RcppSexp.cpp 2009-12-27 16:23:08 UTC (rev 214)
+++ pkg/src/RcppSexp.cpp 2009-12-27 17:15:20 UTC (rev 215)
@@ -3,6 +3,7 @@
// RcppSexp.h: Rcpp R/C++ interface class library -- SEXP support
//
// Copyright (C) 2009 Dirk Eddelbuettel
+// Copyright (C) 2009 Romain Francois
//
// This file is part of Rcpp.
//
Modified: pkg/src/RcppSexp.h
===================================================================
--- pkg/src/RcppSexp.h 2009-12-27 16:23:08 UTC (rev 214)
+++ pkg/src/RcppSexp.h 2009-12-27 17:15:20 UTC (rev 215)
@@ -3,6 +3,7 @@
// RcppSexp.h: Rcpp R/C++ interface class library -- SEXP support
//
// Copyright (C) 2009 Dirk Eddelbuettel
+// Copyright (C) 2009 Romain Francois
//
// This file is part of Rcpp.
//
More information about the Rcpp-commits
mailing list