R Under development (unstable) (2024-05-17 r86565 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > source(file.path("_helper", "init.R")) > source(file.path("aammrtf", "ref.R")); make_ref_obj_funs("exec") > > suppressWarnings(glob <- unitizer:::unitizerGlobal$new()) > > # - "Invisible Expression" ----------------------------------------------------- > > e <- new.env() > exp <- quote(x <- 1:30) > all.equal(1:30, unitizer:::eval_user_exp(exp, e, global = glob)$value) [1] TRUE > > # `eval_user_exp` must be evaluated outside of test_that; also note that by > # design this will output stuff to stderr and stdout > out.err <- capture.output(type = "message", out.std <- capture.output({ + test.obj.s3 <- structure("hello", class = "test_obj") + setClass("testObj", list(a = "character")) + test.obj.s4 <- new("testObj", a = "goodday") + print.test_obj <- function(x, ...) stop("Error in Print") + setMethod("show", "testObj", function(object) stop("Error in Show")) + fun_signal <- function() signalCondition(simpleError("Error in Function", + sys.call())) + fun_error <- function() stop("Error in function 2") + fun_error_cond <- function() stop(simpleError("Error in function 2", + sys.call())) + fun_error_cond_call <- function() fun_error_cond() + fun_s3 <- function() test.obj.s3 + fun_s4 <- function() test.obj.s4 + fun_msg <- function() message("This is a Message") + fun_warn <- function() warning("This is a warning", immediate. = TRUE) + eval.env <- sys.frame(sys.nframe()) + ex0 <- unitizer:::eval_user_exp(quote(stop()), eval.env, + global = glob) + unitizer:::set_trace(ex0$trace) + trace0 <- unitizer:::unitizer_traceback() + ex1 <- unitizer:::eval_user_exp(quote(fun_signal()), eval.env, + global = glob) + unitizer:::set_trace(ex1$trace) + trace1 <- unitizer:::unitizer_traceback() + ex2 <- unitizer:::eval_user_exp(quote(fun_error()), eval.env, + global = glob) + unitizer:::set_trace(ex2$trace) + trace2 <- unitizer:::unitizer_traceback() + ex2a <- unitizer:::eval_user_exp(expression(fun_error()), + eval.env, global = glob) + unitizer:::set_trace(ex2a$trace) + trace2a <- unitizer:::unitizer_traceback() + ex6 <- unitizer:::eval_user_exp(quote(fun_error_cond()), + eval.env, global = glob) + unitizer:::set_trace(ex6$trace) + trace6 <- unitizer:::unitizer_traceback() + ex7 <- unitizer:::eval_user_exp(quote(fun_error_cond_call()), + eval.env, global = glob) + unitizer:::set_trace(ex7$trace) + trace7 <- unitizer:::unitizer_traceback() + ex3 <- unitizer:::eval_user_exp(quote(fun_s3()), eval.env, + global = glob) + unitizer:::set_trace(ex3$trace) + trace3 <- unitizer:::unitizer_traceback() + ex3a <- unitizer:::eval_user_exp(expression(fun_s3()), eval.env, + global = glob) + unitizer:::set_trace(ex3a$trace) + trace3a <- unitizer:::unitizer_traceback() + ex4 <- unitizer:::eval_user_exp(quote(fun_s4()), eval.env, + global = glob) + ex4a <- unitizer:::eval_user_exp(expression(fun_s4()), eval.env, + global = glob) + unitizer:::set_trace(ex4a$trace) + trace4a <- unitizer:::unitizer_traceback() + ex5 <- unitizer:::eval_user_exp(quote(sum(1:20)), eval.env, + global = glob) + ex9 <- unitizer:::eval_user_exp(quote(fun_warn()), eval.env, + global = glob) + ex10 <- unitizer:::eval_user_exp(quote(fun_msg()), eval.env, + global = glob) + ex11 <- unitizer:::eval_user_exp(quote((function() quote(stop("shouldn't error")))()), + eval.env, global = glob) + })) > # NOTE: deparsed test values generated with unitizer:::deparse_mixed > > # - "User Expression Evaluation" ----------------------------------------------- > > # a condition error, signaled, not stop (hence no aborted, etc.) > identical(ex1, rds(100)) [1] TRUE > # a stop > identical(ex2, rds(200)) [1] TRUE > # ex3 and ex3a are a total PITA because the calls need to be manually copied > # b/c they don't deparse properly even with control="all", the trace and > # call component loose the `structure` part in the quoted portions... > # a stop in print; > identical(ex3, rds(300)) [1] TRUE > identical(ex3a, rds(400)) [1] TRUE > # S4 objects; these originally caused problems since they don't deparse > identical(ex4, rds(500)) [1] TRUE > identical(ex4a, rds(600)) [1] TRUE > # a normal expression > identical(ex5, rds(700)) [1] TRUE > identical(ex9, rds(800)) [1] TRUE > all.equal(ex10, rds(900)) # not sure why identical doesn't work here [1] TRUE > # expect_false(ex11$aborted) > ex11$aborted # FALSE [1] FALSE > > # - "Trace Setting" ------------------------------------------------------------ > > identical(trace0, trace1) [1] TRUE > # expect_identical(trace2, list("stop(\"Error in function 2\")", > # "fun_error()")) > trace2 [[1]] [1] "stop(\"Error in function 2\")" [[2]] [1] "fun_error()" > trace6 [[1]] [1] "stop(simpleError(\"Error in function 2\", sys.call()))" [[2]] [1] "fun_error_cond()" > trace7 [[1]] [1] "stop(simpleError(\"Error in function 2\", sys.call()))" [[2]] [1] "fun_error_cond()" [[3]] [1] "fun_error_cond_call()" > trace3a [[1]] [1] "stop(\"Error in Print\")" [[2]] [1] "print.test_obj(\"hello\")" [[3]] [1] "print(\"hello\")" > > # needed to tweak this one so it would pass in R-devel 3.4.1 > # expect_true(all(mapply(function(x, y) grepl(y, x), trace4a, list("stop\\(\"Error in Show\"\\)", > # "show\\(.*\"testObj\".*\\)", "show\\(.*\"testObj\".*\\)")))) > all( + mapply( + function(x, y) grepl(y, x), + trace4a, + list( + "stop\\(\"Error in Show\"\\)", + "show\\(.*\"testObj\".*\\)", "show\\(.*\"testObj\".*\\)") + ) ) [1] TRUE > # - "Clean Top Level Message" -------------------------------------------------- > > old.width <- options(width = 80L) > a <- unitizer:::eval_with_capture( + expression(stop("short stop message")), global = glob + ) > b <- unitizer:::eval_with_capture( + expression(stop("short stop .* with regex message")), global = glob + ) > c <- unitizer:::eval_with_capture( + expression(stop("this is a long error message that is supposed to cause R to add a new line after the error: part")), + global = glob + ) > d <- unitizer:::eval_with_capture( + expression(warning("short warning message")), global = glob + ) > e <- unitizer:::eval_with_capture( + expression(warning("short warning message .* with regex")), global = glob + ) > f <- unitizer:::eval_with_capture( + expression( + warning("this is a long error message that is supposed to cause R to add a new line after the error: part") + ), + global = glob + ) > g <- unitizer:::eval_with_capture( + quote(stop("short stop message")), global = glob + ) > h <- unitizer:::eval_with_capture( + quote(stop("short stop .* with regex message")), global = glob + ) > i <- unitizer:::eval_with_capture( + quote(stop("this is a long error message that is supposed to cause R to add a new line after the error: part")), + global = glob + ) > j <- unitizer:::eval_with_capture( + quote(warning("short warning message")), global = glob + ) > k <- unitizer:::eval_with_capture( + quote(warning("short warning message .* with regex")), global = glob + ) > l <- unitizer:::eval_with_capture( + quote(warning("this is a long error message that is supposed to cause R to add a new line after the error: part")), + global = glob + ) > m <- unitizer:::eval_with_capture(expression("a"/3), global = glob) > exp.q <- quote({ + fun <- function() warning("error in fun") + message("boo hay \n there \n") + warning("this is a fairly long warning wladsfasdfasd that might wrap if we keep typing humpty dumpty sat on a wall and had a big fall") + warning("ashorter warning blah") + message("boo hay \n there \n") + warning() + fun() + suppressWarnings(warning("quiet warn")) + message("boo hay \n there \n") + error(3) + }) > x <- unitizer:::eval_with_capture(exp.q, global = glob) > exp.exp <- expression({ + fun <- function() warning("error in fun") + message("boo hay \n there \n") + warning("this is a fairly long warning wladsfasdfasd that might wrap if we keep typing humpty dumpty sat on a wall and had a big fall") + warning("ashorter warning blah") + message("boo hay \n there \n") + warning() + fun() + suppressWarnings(warning("quiet warn")) + message("boo hay \n there \n") + error(3) + }) > y <- unitizer:::eval_with_capture(exp.exp, global = glob) > options(old.width) > > a$message [1] "Error: short stop message\n" > b$message [1] "Error: short stop .* with regex message\n" > c$message [1] "Error: \n this is a long error message that is supposed to cause R to add a new line after the error: part\n" > d$message [1] "Warning: short warning message\n" > e$message [1] "Warning: short warning message .* with regex\n" > f$message [1] "Warning:\n this is a long error message that is supposed to cause R to add a new line after the error: part\n" > g$message [1] "Error: short stop message\n" > h$message [1] "Error: short stop .* with regex message\n" > i$message [1] "Error: \n this is a long error message that is supposed to cause R to add a new line after the error: part\n" > j$message [1] "Warning: short warning message\n" > k$message [1] "Warning: short warning message .* with regex\n" > l$message [1] "Warning:\n this is a long error message that is supposed to cause R to add a new line after the error: part\n" > m$message [1] "Error in \"a\"/3 : non-numeric argument to binary operator\n" > > # `sub` needed due to inconsistencies in R 3.4 and 3.3 for top level error > # messages > writeLines(sub("\\bError.*: ", "", x$message)) boo hay there Warning: this is a fairly long warning wladsfasdfasd that might wrap if we keep typing humpty dumpty sat on a wall and had a big fall Warning: ashorter warning blah boo hay there Warning: Warning in fun() : error in fun boo hay there could not find function "error" > writeLines(sub("\\bError.*: ", "", y$message)) boo hay there Warning: this is a fairly long warning wladsfasdfasd that might wrap if we keep typing humpty dumpty sat on a wall and had a big fall Warning: ashorter warning blah boo hay there Warning: Warning in fun() : error in fun boo hay there could not find function "error" > > > proc.time() user system elapsed 0.48 0.15 0.57