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("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"))
Error in unitizer:::get_text_capture(cons, "output", TRUE, chrs.max = "howdy") : 
  Argument `chrs.max` must be integer(1L) and greater than 100L; using 200000L for nowTRUE
> # Warn max capt
> cpt0 <- unitizer:::get_text_capture(cons, "output", TRUE)
Warning in get_text(slot(cons, if (type == "message") "err.c" else "out.c")) :
  Reached maximum text capture characters 100; see `getOption("unitizer.max.capture.chars")`
> nchar(cpt0)
[1] 100
> 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)
Warning in get_text(slot(cons, if (type == "message") "err.c" else "out.c")) :
  Reached maximum text capture characters 100; see `getOption("unitizer.max.capture.chars")`
> sink(type = "message")
> all.equal(cpt0.err, substr(base.char.2, 1, 100))
[1] TRUE
> 
> ## 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)
Warning in get_text(slot(cons, if (type == "message") "err.c" else "out.c")) :
  Reached maximum text capture characters 100; see `getOption("unitizer.max.capture.chars")`
> all.equal(cpt1, paste0(rep("y", 100), collapse = ""))
[1] TRUE
> 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)
Warning in unitizer:::get_text(con, 10) :
  Reached maximum text capture characters 10; see `getOption("unitizer.max.capture.chars")`
[1] "a b c d e "
> # should still be to writing to our file, 10 chars in
> cat("boogiewoogy", file = stderr())
> sink(type = "message")
> suppressWarnings(readLines(f))  # incomplete final line...
[1] "a b c d e boogiewoogy l m n o p q r s t u v w x y z"
> 
> 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
$output
[1] "hello there\n"

$message
[1] "goodbye there\n"

> # expect_identical(as.integer(stdout()), out.num)
> identical(as.integer(stdout()), out.num)
[1] TRUE
> identical(as.integer(stderr()), err.num)
[1] TRUE
> 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")
[1] TRUE
> attr(cons@err.c, "waive")
[1] TRUE
> capt
$output
[1] "there hello\n"

$message
[1] "there goodbye\n"

> readLines(f1)
[1] "12 there hello"
> readLines(f2)
[1] "12 there goodbye"
> 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
NULL
> attr(cons@err.c, "waive")  # NULL
NULL
> capt
$output
[1] "there hello\n"

$message
[1] "there goodbye\n"

> unitizer:::close_and_clear(cons)
> readLines(f1)
[1] "12 there hello"
> readLines(f2)
[1] "12 there goodbye"
> 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")
| Unable to restore original message sink, setting back to normal stderr

> any(grepl("connection", cons.txt))
[1] TRUE
> sink(err.con, type = "message")
> status["message"]
message 
  FALSE 
> 
> # - "eval with capt" -----------------------------------------------------------
> 
> suppressWarnings(glob <- unitizer:::unitizerGlobal$new())
> all.equal(
+   (capt <- unitizer:::eval_with_capture(quote(1 + 1), global = glob))[1:8],
+   rds(100)
+ )
[1] TRUE
> is(capt[[9]], "unitizerCaptCons")
[1] TRUE
> all.equal(
+   (
+     capt <- unitizer:::eval_with_capture(
+       cat("wow\n", file = stderr()), global = glob)
+   )[1:8],
+   rds(200)
+ )
[1] TRUE
> is(capt[[9]], "unitizerCaptCons")
[1] TRUE
> 
> proc.time()
   user  system elapsed 
   0.48    0.04    0.53