1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
reset <- function() {
testRcppInterfaceUser::reset_flags()
testRcppInterfaceExporter::reset_flags()
}
# This tests errors converted to exceptions by Rcpp_eval()
x <- tryCatch(
error = identity,
testRcppInterfaceUser::use_cpp_interface(quote(stop("jump!")))
)
stopifnot(
grepl("jump!", x$message),
testRcppInterfaceUser::peek_flag("cpp_interface_downstream"),
testRcppInterfaceExporter::peek_flag("cpp_interface_upstream")
)
reset()
# This tests errors converted to resumable longjumps by Rcpp_fast_eval()
x <- tryCatch(
error = identity,
testRcppInterfaceUser::use_cpp_interface(quote(stop("jump!")), fast = TRUE)
)
stopifnot(
grepl("jump!", x$message),
testRcppInterfaceUser::peek_flag("cpp_interface_downstream"),
testRcppInterfaceExporter::peek_flag("cpp_interface_upstream")
)
reset()
# This tests longjumps not caught by Rcpp_eval()
x <- withRestarts(
here = identity,
testRcppInterfaceUser::use_cpp_interface(quote(invokeRestart("here", "value")))
)
stopifnot(identical(x, "value"))
if (getRversion() >= "3.5.0") {
stopifnot(
testRcppInterfaceUser::peek_flag("cpp_interface_downstream"),
testRcppInterfaceExporter::peek_flag("cpp_interface_upstream")
)
}
|
