tests/t-capture.R

In unitizer: Interactive R Unit Tests

source(file.path("_helper", "init.R"))
source(file.path("aammrtf", "ref.R")); make_ref_obj_funs("capture")

# # Messing around trying to understand seek...
# f <- tempfile()
# con <- file(f, "w+b")
# writeChar(paste(letters, LETTERS, collapse=" "), con)
# readChar(con, 20)
# pos <- seek(con, origin="current")
# seek(con, pos, rw="write")
# writeChar("xxxxxxxxx", con)
# readChar(con, 3)
# pos <- seek(con, origin="current")
# seek(con, pos, rw="write")
# writeChar("yyyyy", con)
# close(con)
# readLines(f)
# unlink(f)

# - "get_capture" --------------------------------------------------------------

old.max <- options(unitizer.max.capture.chars = 100L)
cons <- new("unitizerCaptCons")
base.char <- paste(rep(letters, 10), collapse = " ")
writeChar(base.char, cons@out.c)

# Error "Argument `chrs.max`"
try(unitizer:::get_text_capture(cons, "output", TRUE, chrs.max = "howdy"))
# Warn max capt
cpt0 <- unitizer:::get_text_capture(cons, "output", TRUE)
nchar(cpt0)
base.char.2 <- paste(rev(rep(letters, 10)), collapse = " ")
writeChar(base.char.2, cons@err.c)
sink(cons@err.c, type = "message")

cpt0.err <- unitizer:::get_text_capture(cons, "message", FALSE)
sink(type = "message")
all.equal(cpt0.err, substr(base.char.2, 1, 100))

## for some reason this test stopped working; not sure why, need to look into
## it; seemingly it messes up the pointer for the next read
# writeChar("xxxxxx", cons@out.c)
# cpt2 <- unitizer:::get_text_capture(cons, "output", TRUE)
# expect_equal("xxxxxx", cpt2)
writeChar(paste0(rep("yyyyyyy", 20L), collapse = ""), cons@out.c)
# warn max capt
cpt1 <- unitizer:::get_text_capture(cons, "output", TRUE)
all.equal(cpt1, paste0(rep("y", 100), collapse = ""))
unitizer:::close_and_clear(cons)
options(old.max)

# - "get_text" -----------------------------------------------------------------

old.max <- options(unitizer.max.capture.chars = 100L)
f <- tempfile()
con <- file(f, "w+b")
base.char <- paste(letters, collapse = " ")
sink(con, type = "message")
cat(base.char, file = stderr())
# this needs to temporarily switch the sink to be able to issue the warning
# Warn: "Reached maximum"
unitizer:::get_text(con, 10)
# should still be to writing to our file, 10 chars in
cat("boogiewoogy", file = stderr())
sink(type = "message")
suppressWarnings(readLines(f))  # incomplete final line...

options(old.max)
unlink(f)

# - "connection capture works" -------------------------------------------------

out.num <- as.integer(stdout())
err.num <- as.integer(stderr())
err.con <- getConnection(sink.number(type = "message"))
cons <- new("unitizerCaptCons")
cons <- unitizer:::set_capture(cons)
cat("hello there\n")
cat("goodbye there\n", file = stderr())
capt <- unitizer:::get_capture(cons)
cons <- unitizer:::unsink_cons(cons)
capt
# expect_identical(as.integer(stdout()), out.num)
identical(as.integer(stdout()), out.num)
identical(as.integer(stderr()), err.num)
unitizer:::close_and_clear(cons)

# Now, here we add an extra stdout sink. In both cases unsink_cons will not
# touch the sinks since we're not in an expected state, leaving
# close_and_clear to cleanup
err.con <- getConnection(sink.number(type = "message"))
cons <- new("unitizerCaptCons")
cons <- unitizer:::set_capture(cons)
cat("there hello\n")
# message does not work with testthat
cat("there goodbye\n", file = stderr())
f1 <- tempfile()
f2 <- tempfile()
c2 <- file(f2, "w")
sink(f1)
sink(c2, type = "message")
cat("12 there hello\n")
# message does not work with testthat
cat("12 there goodbye\n", file = stderr())
capt <- unitizer:::get_capture(cons)
cons <- unitizer:::unsink_cons(cons)
unitizer:::close_and_clear(cons)
attr(cons@out.c, "waive")
attr(cons@err.c, "waive")
capt
readLines(f1)
readLines(f2)
close(c2)
unlink(c(f1, f2))

# Same, but this time close the sinks properly, so the connections should not
# be waived
err.con <- getConnection(sink.number(type = "message"))
cons <- new("unitizerCaptCons")
cons <- unitizer:::set_capture(cons)
cat("there hello\n")
# message does not work with testthat
cat("there goodbye\n", file = stderr())
f1 <- tempfile()
f2 <- tempfile()
c2 <- file(f2, "w")
sink(f1)
sink(c2, type = "message")
cat("12 there hello\n")
# message does not work with testthat
cat("12 there goodbye\n", file = stderr())
sink()
sink(cons@err.c, type = "message")
capt <- unitizer:::get_capture(cons)
cons <- unitizer:::unsink_cons(cons)
attr(cons@out.c, "waive")  # NULL
attr(cons@err.c, "waive")  # NULL
capt
unitizer:::close_and_clear(cons)
readLines(f1)
readLines(f2)
close(c2)
unlink(c(f1, f2))
# Try to mess up sink counter by replacing the real sink with a fake sink
# should lead to a waived connection
cons <- new("unitizerCaptCons")
cons <- unitizer:::set_capture(cons)
f1 <- tempfile()
sink()
sink(f1)
capt <- unitizer:::get_capture(cons)
cons <- unitizer:::unsink_cons(cons)
attr(cons@out.c, "waive")
attr(cons@err.c, "waive")
capt
# Try to fix so that we don't get a full stack release error
sink()
sink(cons@out.c)
unitizer:::close_and_clear(cons)
unlink(f1)
# helper function
f1 <- tempfile()
f2 <- tempfile()
c1 <- file(f1, "w+b")
c2 <- file(f2, "w+b")
sink(c2)
unitizer:::is_stdout_sink(f1)
sink()
sink(c1)
unitizer:::is_stdout_sink(f1)
sink()
close(c1)
close(c2)
unlink(c(f1, f2))

# - "connection breaking tests" ------------------------------------------------

# # These tests cannot be run as they blow away the entire sink stack which can
# # mess up any testing done under capture
#
# test_that("connection breaking tests", {
#   # Test the more pernicious error where we substitute the stdout sink
#
#   cons <- new("unitizerCaptCons")
#   cons <- unitizer:::set_capture(cons)
#   cat("woohoo\n")
#   cat("yohooo\n", file=stderr())
#   f1 <- tempfile()
#   sink()
#   sink(f1)
#   capt <- unitizer:::get_capture(cons)
#   cons <- unitizer:::unsink_cons(cons)
#   sink()
#   unlink(f1)
#   expect_true(attr(cons@out.c, "waive"))
#   expect_null(attr(cons@err.c, "waive"))
#   expect_identical(
#     capt, list(output = "woohoo\n", message = "yohooo\n")
#   )
#   expect_identical(
#     unitizer:::close_and_clear(cons),
#     structure(c(FALSE, TRUE), .Names = c("output", "message"))
#   )
# })

# - "close_and_clear" ----------------------------------------------------------

# need some careful handling to make sure we don't mess up the testthat's
# sinking (legacy behavior)
cons <- new("unitizerCaptCons")
err.con <- cons@stderr.con
on.exit(sink(err.con, type = "message"))
# intended to cause an error
cons@stderr.con <- list()
# msg:  "Unable to restore original "
cons.txt <- capture.output(status <- unitizer:::close_and_clear(cons), 
    type = "message")
any(grepl("connection", cons.txt))
sink(err.con, type = "message")
status["message"]

# - "eval with capt" -----------------------------------------------------------

suppressWarnings(glob <- unitizer:::unitizerGlobal$new())
all.equal(
  (capt <- unitizer:::eval_with_capture(quote(1 + 1), global = glob))[1:8],
  rds(100)
)
is(capt[[9]], "unitizerCaptCons")
all.equal(
  (
    capt <- unitizer:::eval_with_capture(
      cat("wow\n", file = stderr()), global = glob)
  )[1:8],
  rds(200)
)
is(capt[[9]], "unitizerCaptCons")