1 2## Copyright (C) 2010 - 2020 Dirk Eddelbuettel and Romain Francois 3## 4## This file is part of Rcpp. 5## 6## Rcpp is free software: you can redistribute it and/or modify it 7## under the terms of the GNU General Public License as published by 8## the Free Software Foundation, either version 2 of the License, or 9## (at your option) any later version. 10## 11## Rcpp is distributed in the hope that it will be useful, but 12## WITHOUT ANY WARRANTY; without even the implied warranty of 13## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14## GNU General Public License for more details. 15## 16## You should have received a copy of the GNU General Public License 17## along with Rcpp. If not, see <http://www.gnu.org/licenses/>. 18 19if (Sys.getenv("RunAllRcppTests") != "yes") exit_file("Set 'RunAllRcppTests' to 'yes' to run.") 20 21## used below 22.onWindows <- .Platform$OS.type == "windows" 23.onSolaris <- Sys.info()[["sysname"]] == "SunOS" 24 25Rcpp::sourceCpp("cpp/exceptions.cpp") 26 27#test.stdException <- function() { 28## Code works normally without an exception 29expect_identical(takeLog(1L), log(1L)) 30 31## C++ exceptions are converted to R conditions 32condition <- tryCatch(takeLog(-1L), error = identity) 33 34expect_identical(condition$message, "Inadmissible value") 35expect_identical(class(condition), c("std::range_error", "C++Error", "error", "condition")) 36 37## C++ stack only available for Rcpp::exceptions 38expect_true(is.null(condition$cppstack)) 39 40expect_identical(condition$call, quote(takeLog(-1L))) 41 42 43#test.rcppException <- function() { 44 45## Code works normally without an exception 46expect_identical(takeLog(1L), log(1L)) 47 48## C++ exceptions are converted to R conditions 49condition <- tryCatch(takeLogRcpp(-1L), error = identity) 50 51expect_identical(condition$message, "Inadmissible value") 52expect_identical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition")) 53 54if (.onWindows) exit_file("Skipping remainder of file on Windows") 55if (.onSolaris) exit_file("Skipping remainder of file on Solaris") 56 57expect_true(!is.null(condition$cppstack)) 58 59expect_identical(class(condition$cppstack), "Rcpp_stack_trace") 60 61expect_equal(condition$call, quote(takeLogRcpp(-1L))) 62 63 64#test.rcppStop <- function() { 65## Code works normally without an exception 66expect_identical(takeLog(1L), log(1L)) 67 68## C++ exceptions are converted to R conditions 69condition <- tryCatch(takeLogStop(-1L), error = identity) 70 71expect_identical(condition$message, "Inadmissible value") 72expect_identical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition")) 73 74expect_true(!is.null(condition$cppstack)) 75 76expect_identical(class(condition$cppstack), "Rcpp_stack_trace") 77 78expect_equal(condition$call, quote(takeLogStop(-1L))) 79 80 81#test.rcppExceptionLocation <- function() { 82 83## Code works normally without an exception 84expect_identical(takeLog(1L), log(1L)) 85 86## C++ exceptions are converted to R conditions 87condition <- tryCatch(takeLogRcppLocation(-1L), error = identity) 88 89expect_identical(condition$message, "Inadmissible value") 90expect_identical(class(condition), c("Rcpp::exception", "C++Error", "error", "condition")) 91 92expect_true(!is.null(condition$cppstack)) 93expect_identical(class(condition$cppstack), "Rcpp_stack_trace") 94 95#expect_identical(condition$cppstack$file, "exceptions.cpp") 96#expect_identical(condition$cppstack$line, 44L) 97 98expect_equal(condition$call, quote(takeLogRcppLocation(-1L))) 99 100 101#test.rcppExceptionLocation <- function() { 102 103## Nested exceptions work the same way 104normal <- tryCatch(takeLogRcppLocation(-1L), error = identity) 105f1 <- function(x) takeLogNested(x) 106 107nested <- tryCatch(f1(-1), error = identity) 108 109## Message the same 110expect_identical(normal$message, nested$message) 111 112expect_equal(nested$call, quote(takeLogNested(x))) 113 114 115#test.rcppExceptionNoCall <- function() { 116 117## Can throw exceptions that don't include a call stack 118e <- tryCatch(noCall(), error = identity) 119 120expect_identical(e$message, "Testing") 121expect_identical(e$call, NULL) 122expect_identical(e$cppstack, NULL) 123expect_identical(class(e), c("Rcpp::exception", "C++Error", "error", "condition")) 124