tests/t-exec.R

In unitizer: Interactive R Unit Tests

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)

# `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))
# a stop
identical(ex2, rds(200))
# 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))
identical(ex3a, rds(400))
# S4 objects; these originally caused problems since they don't deparse
identical(ex4, rds(500))
identical(ex4a, rds(600))
# a normal expression
identical(ex5, rds(700))
identical(ex9, rds(800))
all.equal(ex10, rds(900)) # not sure why identical doesn't work here
# expect_false(ex11$aborted)
ex11$aborted  # FALSE

# - "Trace Setting" ------------------------------------------------------------

identical(trace0, trace1)
# expect_identical(trace2, list("stop(\"Error in function 2\")",
#     "fun_error()"))
trace2
trace6
trace7
trace3a

# 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\".*\\)")
) )
# - "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
b$message
c$message
d$message
e$message
f$message
g$message
h$message
i$message
j$message
k$message
l$message
m$message

# `sub` needed due to inconsistencies in R 3.4 and 3.3 for top level error
# messages
writeLines(sub("\\bError.*: ", "", x$message))
writeLines(sub("\\bError.*: ", "", y$message))