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