diff --git a/ChangeLog b/ChangeLog index 865dd53c8..e166ccfeb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -28,6 +28,13 @@ * inst/include/Rcpp/date_datetime/newDatetimeVector.h: Added constructor to instantiate newDatetimeVector from VectorBase. +2016-11-11 Jim Hester + * inst/include/rcpp/exceptions.h: Return stack trace even if no file + or line is specified. Fix R calls when using Rcpp_eval. + * inst/include/rcpp/routines.h:allow getting a cppstack without specifying a file and line. + * src/api.cpp: Add cppstack support for clang. + * r/exceptions.r:Add a str method for Rcpp_stack_trace objects. + * NAMESPACE: Idem 2016-11-04 Nathan Russell diff --git a/NAMESPACE b/NAMESPACE index 6025801a2..2c7e21078 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,10 +31,13 @@ export(Module, demangle, sizeof, cpp_object_initializer, - cpp_object_dummy, + cpp_object_dummy, Rcpp.plugin.maker ) S3method(print, bytes) +S3method(format, Rcpp_stack_trace) +S3method(str, Rcpp_stack_trace) +S3method(print, Rcpp_stack_trace) exportClass(RcppClass) diff --git a/R/exceptions.R b/R/exceptions.R index 852c8db75..96a837230 100644 --- a/R/exceptions.R +++ b/R/exceptions.R @@ -33,4 +33,16 @@ warnings } +print.Rcpp_stack_trace <- function(x, ...) { + cat(format(x, ...)) +} + +str.Rcpp_stack_trace <- function(object, ...) { + cat(format(object, ...)) +} +format.Rcpp_stack_trace <- function(x, ...) { + paste0( + if (nzchar(x$file)) paste0(x$file, ":", x$line), + "\n ", paste(collapse = "\n ", seq_along(x$stack), ":", x$stack), "\n") +} diff --git a/inst/include/Rcpp/exceptions.h b/inst/include/Rcpp/exceptions.h index 107344af4..595344df0 100644 --- a/inst/include/Rcpp/exceptions.h +++ b/inst/include/Rcpp/exceptions.h @@ -28,7 +28,7 @@ namespace Rcpp{ class exception : public std::exception { public: - explicit exception(const char* message_) : message(message_){} + explicit exception(const char* message_) : message(message_){ rcpp_set_stack_trace(stack_trace()); } exception(const char* message_, const char* file, int line ) : message(message_){ rcpp_set_stack_trace( stack_trace(file,line) ) ; } @@ -124,20 +124,58 @@ namespace Rcpp{ #undef RCPP_SIMPLE_EXCEPTION_CLASS +namespace internal { + + inline SEXP nth(SEXP s, int n) { + return Rf_length(s) > n ? (n == 0 ? CAR(s) : CAR(Rf_nthcdr(s, n))) : R_NilValue; + } + + // We want the call just prior to the call from Rcpp_eval + // This conditional matches + // tryCatch(evalq(sys.calls(), .GlobalEnv), error = identity, interrupt = identity) + inline bool is_Rcpp_eval_call(SEXP expr) { + SEXP sys_calls_symbol = Rf_install("sys.calls"); + SEXP identity_symbol = Rf_install("identity"); + SEXP identity_fun = Rf_findFun(identity_symbol, R_BaseEnv); + SEXP tryCatch_symbol = Rf_install("tryCatch"); + SEXP evalq_symbol = Rf_install("evalq"); + + return TYPEOF(expr) == LANGSXP && + Rf_length(expr) == 4 && + nth(expr, 0) == tryCatch_symbol && + CAR(nth(expr, 1)) == evalq_symbol && + CAR(nth(nth(expr, 1), 1)) == sys_calls_symbol && + nth(nth(expr, 1), 2) == R_GlobalEnv && + nth(expr, 2) == identity_fun && + nth(expr, 3) == identity_fun; + } +} + } // namespace Rcpp inline SEXP get_last_call(){ - SEXP sys_calls_symbol = Rf_install( "sys.calls" ) ; - Rcpp::Shield sys_calls_expr( Rf_lang1(sys_calls_symbol) ); - Rcpp::Shield calls( Rcpp_eval( sys_calls_expr, R_GlobalEnv ) ); - SEXP res = calls ; - while( !Rf_isNull(CDR(res)) ) res = CDR(res); - return CAR(res) ; + SEXP sys_calls_symbol = Rf_install("sys.calls"); + + Rcpp::Shield sys_calls_expr(Rf_lang1(sys_calls_symbol)); + Rcpp::Shield calls(Rcpp_eval(sys_calls_expr, R_GlobalEnv)); + + SEXP cur, prev; + prev = cur = calls; + while(CDR(cur) != R_NilValue) { + SEXP expr = CAR(cur); + + if (Rcpp::internal::is_Rcpp_eval_call(expr)) { + break; + } + prev = cur; + cur = CDR(cur); + } + return CAR(prev); } inline SEXP get_exception_classes( const std::string& ex_class) { Rcpp::Shield res( Rf_allocVector( STRSXP, 4 ) ); - + #ifndef RCPP_USING_UTF8_ERROR_STRING SET_STRING_ELT( res, 0, Rf_mkChar( ex_class.c_str() ) ) ; #else @@ -184,7 +222,7 @@ inline SEXP exception_to_r_condition( const std::exception& ex){ inline SEXP string_to_try_error( const std::string& str){ using namespace Rcpp; - + #ifndef RCPP_USING_UTF8_ERROR_STRING Rcpp::Shield simpleErrorExpr( Rf_lang2(::Rf_install("simpleError"), Rf_mkString(str.c_str())) ); Rcpp::Shield tryError( Rf_mkString( str.c_str() ) ); @@ -193,7 +231,7 @@ inline SEXP string_to_try_error( const std::string& str){ SET_STRING_ELT( tryError, 0, Rf_mkCharLenCE( str.c_str(), str.size(), CE_UTF8 ) ); Rcpp::Shield simpleErrorExpr( Rf_lang2(::Rf_install("simpleError"), tryError )); #endif - + Rcpp::Shield simpleError( Rf_eval(simpleErrorExpr, R_GlobalEnv) ); Rf_setAttrib( tryError, R_ClassSymbol, Rf_mkString("try-error") ) ; Rf_setAttrib( tryError, Rf_install( "condition") , simpleError ) ; @@ -267,52 +305,52 @@ namespace Rcpp{ inline void NORET stop(const std::string& message) { throw Rcpp::exception(message.c_str()); } - + template inline void NORET stop(const char* fmt, const T1& arg1) { throw Rcpp::exception( tfm::format(fmt, arg1 ).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2 ).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4, arg5).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4, arg5, arg6).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7, const T8& arg8) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7, const T8& arg8, const T9& arg9) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9).c_str() ); } - + template inline void NORET stop(const char* fmt, const T1& arg1, const T2& arg2, const T3& arg3, const T4& arg4, const T5& arg5, const T6& arg6, const T7& arg7, const T8& arg8, const T9& arg9, const T10& arg10) { throw Rcpp::exception( tfm::format(fmt, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9, arg10).c_str() ); diff --git a/inst/include/Rcpp/routines.h b/inst/include/Rcpp/routines.h index 1f89d4f6b..941898aad 100644 --- a/inst/include/Rcpp/routines.h +++ b/inst/include/Rcpp/routines.h @@ -43,7 +43,7 @@ SEXP rcpp_set_stack_trace(SEXP); std::string demangle(const std::string& name); const char* short_file_name(const char* ); int* get_cache(int n); -SEXP stack_trace( const char *file, int line); +SEXP stack_trace( const char *file = "", int line = -1); SEXP get_string_elt(SEXP s, R_xlen_t i); const char* char_get_string_elt(SEXP s, R_xlen_t i); void set_string_elt(SEXP s, R_xlen_t i, SEXP v); @@ -143,7 +143,7 @@ inline attribute_hidden const char* short_file_name(const char* file) { return fun(file); } -inline attribute_hidden SEXP stack_trace( const char *file, int line){ +inline attribute_hidden SEXP stack_trace( const char *file = "", int line = -1){ typedef SEXP (*Fun)(const char*, int); static Fun fun = GET_CALLABLE("stack_trace"); return fun(file, line); diff --git a/inst/unitTests/cpp/exceptions.cpp b/inst/unitTests/cpp/exceptions.cpp new file mode 100644 index 000000000..e891ebc6f --- /dev/null +++ b/inst/unitTests/cpp/exceptions.cpp @@ -0,0 +1,56 @@ +// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*- +// +// dates.cpp: Rcpp R/C++ interface class library -- Date + Datetime tests +// +// Copyright (C) 2010 - 2013 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 . + +#include +using namespace Rcpp; + +// [[Rcpp::export]] +double takeLog(double val) { + if (val <= 0.0) { + throw std::range_error("Inadmissible value"); + } + return log(val); +} + +// [[Rcpp::export]] +double takeLogRcpp(double val) { + if (val <= 0.0) { + throw Rcpp::exception("Inadmissible value"); + } + return log(val); +} + +// [[Rcpp::export]] +double takeLogRcppLocation(double val) { + if (val <= 0.0) { + throw Rcpp::exception("Inadmissible value", "exceptions.cpp", 44); + } + return log(val); +} + +double f1(double val) { + return takeLogRcppLocation(val); +} + +// [[Rcpp::export]] +double takeLogNested(double val) { + return f1(val); +} diff --git a/inst/unitTests/runit.exceptions.R b/inst/unitTests/runit.exceptions.R new file mode 100644 index 000000000..4a1f77002 --- /dev/null +++ b/inst/unitTests/runit.exceptions.R @@ -0,0 +1,95 @@ +#!/usr/bin/env r +# -*- mode: R; tab-width: 4; -*- +# +# Copyright (C) 2010 - 2013 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 . +.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes" + +if (.runThisTest) { + .setUp <- Rcpp:::unitTestSetup("exceptions.cpp") + +test.stdException <- function() { + + # Code works normally without an exception + checkIdentical(takeLog(1L), log(1L)) + + # C++ exceptions are converted to R conditions + condition <- tryCatch(takeLog(-1L), error = identity) + + checkIdentical(condition$message, "Inadmissible value") + checkIdentical(class(condition), c("std::range_error", "C++Error", "error", "condition")) + + # C++ stack only available for Rcpp::exceptions + checkTrue(is.null(condition$cppstack)) + + checkIdentical(condition$call, quote(takeLog(-1L))) +} + + +test.rcppException <- function() { + + # Code works normally without an exception + checkIdentical(takeLog(1L), log(1L)) + + # C++ exceptions are converted to R conditions + condition <- tryCatch(takeLogRcpp(-1L), error = identity) + + checkIdentical(condition$message, "Inadmissible value") + checkIdentical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition")) + + checkTrue(!is.null(condition$cppstack)) + + checkIdentical(class(condition$cppstack), "Rcpp_stack_trace") + + checkEquals(condition$call, quote(takeLogRcpp(-1L))) +} + +test.rcppExceptionLocation <- function() { + + # Code works normally without an exception + checkIdentical(takeLog(1L), log(1L)) + + # C++ exceptions are converted to R conditions + condition <- tryCatch(takeLogRcppLocation(-1L), error = identity) + + checkIdentical(condition$message, "Inadmissible value") + checkIdentical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition")) + + checkTrue(!is.null(condition$cppstack)) + checkIdentical(class(condition$cppstack), "Rcpp_stack_trace") + + checkIdentical(condition$cppstack$file, "exceptions.cpp") + checkIdentical(condition$cppstack$line, 44L) + + checkEquals(condition$call, quote(takeLogRcppLocation(-1L))) +} + +test.rcppExceptionLocation <- function() { + + # Nested exceptions work the same way + normal <- tryCatch(takeLogRcppLocation(-1L), error = identity) + f1 <- function(x) takeLogNested(x) + + nested <- tryCatch(f1(-1), error = identity) + + # Message the same + checkIdentical(normal$message, nested$message) + + checkEquals(nested$call, quote(takeLogNested(x))) +} + +} diff --git a/src/api.cpp b/src/api.cpp index a7c8e606b..3bf31caa2 100644 --- a/src/api.cpp +++ b/src/api.cpp @@ -32,7 +32,7 @@ using namespace Rcpp; #include #endif -#if defined(__GNUC__) +#if defined(__GNUC__) || defined(__clang__) #if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__) // do nothing #else @@ -262,7 +262,7 @@ SEXP rcpp_can_use_cxx11() { // [[Rcpp::register]] SEXP stack_trace(const char* file, int line) { - #if defined(__GNUC__) + #if defined(__GNUC__) || defined(__clang__) #if defined(_WIN32) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__CYGWIN__) || defined(__sun) || defined(_AIX) || defined(__MUSL__) // Simpler version for Windows and *BSD List trace = List::create(_["file"] = file,