R Under development (unstable) (2024-08-15 r87022 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.

> R_binary <- file.path(R.home("bin"), "R")
> 
> run_script <- function(script, expected_status, expected_out, description) {
+     # solaris does not like pipes so use tmp files as intermediaries
+     tmpfiles <- tempfile(pattern = c('R_unittest_stdout_','R_unittest_stderr_'), tmpdir = tempdir())
+     exit_status <- withCallingHandlers(
+         system2(
+             R_binary,
+             c("--vanilla", "--slave"),
+             input = paste0(script, collapse = "\n"),
+             wait = TRUE, stdout = tmpfiles[1], stderr = tmpfiles[2]),
+         warning = function (w) {
+             invokeRestart("muffleWarning")
+         }
+     )
+     actual <- readLines(tmpfiles[1])  # only interested in stdout
+     if( isTRUE(all.equal(actual, expected_out)) && exit_status == expected_status) {
+         cat("ok\n")
+     } else {
+         cat("\nExpected status",
+             expected_status,
+             "\nGot status",
+             exit_status,
+             "\nExpected stdout:",
+             expected_out,
+             "\nGot stdout:",
+             actual,
+             sep = "\n"
+         )
+         stop( description )
+     }
+     invisible(c(exit_status, actual))
+ }
> 
> # one test one success
> run_script(
+     "library(unittest)\nok(1==1,\"1 equals 1\")",
+     0,
+     c(
+         "ok - 1 equals 1",
+         "1..1",
+         "# Looks like you passed all 1 tests."
+     ),
+     "One test one success case not as expected"
+ ) 
ok
> 
> # Success with a multi-line expression
> run_script(
+     "library(unittest)\nok(all.equal(c('This is a string', 'This is a string too', 'Exciting times'),\nc('This is a string', 'This is a string too', 'Exciting times')))",
+     0,
+     c(
+         'ok - all.equal(c("This is a string", "This is a string too", "Exc',
+         "1..1",
+         "# Looks like you passed all 1 tests."
+     ),
+     "One test one success case not as expected"
+ ) 
ok
> 
> # two tests two sucesses
> run_script(
+     "library(unittest)\nok(1==1,\"1 equals 1\")\nok(2==2,\"2 equals 2\")",
+     0,
+     c(
+         "ok - 1 equals 1",
+         "ok - 2 equals 2",
+         "1..2",
+         "# Looks like you passed all 2 tests."
+     ),
+     "Two tests two successes case not as expected"
+ ) 
ok
> 
> # one test one failure 
> run_script(
+     "library(unittest)\nok(1!=1,\"1 equals 1\")",
+     10,
+     c(
+         "not ok - 1 equals 1",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "1..1",
+         "# Looks like you failed 1 of 1 tests."
+     ),
+     "One test one failure case not as expected"
+ )
ok
> 
> # four tests two failures, not all tests failed so included which failed
> run_script(
+     "library(unittest)\nok(1==1,\"1 equals 1\")\nok(2!=2,\"2 equals 2\")\nok(3==3,\"3 equals 3\")\nok(4!=4,\"4 equals 4\")",
+     10,
+     c(
+         "ok - 1 equals 1",
+         "not ok - 2 equals 2",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "ok - 3 equals 3",
+         "not ok - 4 equals 4",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "1..4",
+         "# Looks like you failed 2 of 4 tests.",
+         "# 2: 2 equals 2",
+         "# 4: 4 equals 4",
+         NULL
+     ),
+     "Four tests two failures case not as expected"
+ )
ok
> 
> # check detaching stops non_interactive_exit functionality
> run_script(
+     "library(unittest)\nok(1!=1,\"1 equals 1\")\ndetach(package:unittest,unload=FALSE)",
+     0,
+     c(
+         "not ok - 1 equals 1",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE"
+     ),
+     "detaching stops non_interactive_exit functionality"
+ )
ok
> 
> # and if we re-attach it works again
> run_script(
+     "library(unittest)\nok(1!=1,\"1 equals 1\")\ndetach(package:unittest,unload=FALSE)\nlibrary(unittest)\nok(2!=2,\"2 equals 2\")",
+     10,
+     c(
+         "not ok - 1 equals 1",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "not ok - 2 equals 2",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "1..1",
+         "# Looks like you failed 1 of 1 tests."
+     ),
+     "detaching stops non_interactive_exit functionality and then re-attaching resets and the rest still works"
+ )
ok
> 
> # check detaching and unloading stops non_interactive_exit functionality
> run_script(
+     "library(unittest)\nok(1!=1,\"1 equals 1\")\ndetach(package:unittest,unload=TRUE)",
+     0,
+     c(
+         "not ok - 1 equals 1",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE"
+     ),
+     "detaching and unloading stops non_interactive_exit functionality"
+ )
ok
> 
> # and if we reload and re-attach it works again
> run_script(
+     "library(unittest)\nok(1!=1,\"1 equals 1\")\ndetach(package:unittest,unload=TRUE)\nlibrary(unittest)\nok(2!=2,\"2 equals 2\")",
+     10,
+     c(
+         "not ok - 1 equals 1",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "not ok - 2 equals 2",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "1..1",
+         "# Looks like you failed 1 of 1 tests."
+     ),
+     "detaching and unloading stops non_interactive_exit functionality and then reloading and re-attaching resets and the rest still works"
+ )
ok
> 
> # Too many test failures and we don't print a summary
> run_script(
+     paste(
+         "library(unittest)",
+         paste0("ok(1==", 1:30, ", '1 equals ", 1:30, "')", collapse = "\n"),
+         sep = "\n" ),
+     10,
+     c(
+         "ok - 1 equals 1",
+         unlist(strsplit(paste0(
+             "not ok - 1 equals ", 2:30, "\n",
+             "# Test returned non-TRUE value:\n",
+             "# [1] FALSE" ), "\n")),
+         "1..30",
+         "# Looks like you failed 29 of 30 tests.",
+         NULL
+     ),
+     "By setting an errors variable in globalenv we managed to influence unittest output"
+ )
ok
> 
> # Failure outside test
> run_script(
+     paste(
+         "library(unittest)",
+         "ok(1==1, '1 equals 1')",
+         "stop('eek\nook')",
+         "ok(2==2, '2 equals 2')",
+         "", sep = "\n"
+     ),
+     11,
+     c(
+         "ok - 1 equals 1",
+         "Bail out! Looks like 1 tests ran, but script ended prematurely",
+         "# Error: eek",
+         "# ook",
+         "# Traceback:",
+         '#  1: stop("eek\\nook")',
+         NULL
+     ),
+     "Failure outside tests"
+ )
ok
> 
> # Failure before test
> run_script(
+     paste(
+         "library(unittest)",
+         "stop('eek\nook')",
+         "ok(1==1, '1 equals 1')",
+         "ok(2==2, '2 equals 2')",
+         "", sep = "\n"
+     ),
+     11,
+     c(
+         "Bail out! Looks like 0 tests ran, but script ended prematurely",
+         "# Error: eek",
+         "# ook",
+         "# Traceback:",
+         '#  1: stop("eek\\nook")',
+         NULL
+     ),
+     "Failure before tests"
+ )
ok
> 
> # Failure before test-failure (we count all tests, including failures)
> run_script(
+     paste(
+         "library(unittest)",
+         "ok(1==1, '1 equals 1')",
+         "ok(1==2, '1 equals 2')",
+         "stop('eek\nook')",
+         "", sep = "\n"
+     ),
+     11,
+     c(
+         "ok - 1 equals 1",
+         "not ok - 1 equals 2",
+         "# Test returned non-TRUE value:",
+         "# [1] FALSE",
+         "Bail out! Looks like 2 tests ran, but script ended prematurely",
+         "# Error: eek",
+         "# ook",
+         "# Traceback:",
+         '#  1: stop("eek\\nook")',
+         NULL
+     ),
+     "Failure before tests"
+ )
ok
> 
> # tryCatch() doesn't count as failure
> run_script(
+     paste(
+         "library(unittest)",
+         "ok(1==1, '1 equals 1')",
+         "tryCatch(stop('not fatal'), error = function (e) NULL)",
+         "ok(2==2, '2 equals 2')",
+         "", sep = "\n"
+     ),
+     0,
+     c(
+         "ok - 1 equals 1",
+         "NULL",
+         "ok - 2 equals 2",
+         "1..2",
+         "# Looks like you passed all 2 tests.",
+         NULL
+     ),
+     "Caught errors outside tests"
+ )
ok
> 
> # Redirection of output to tempfile
> tf <- tempfile()
> run_script(
+     c(
+         'library(unittest)',
+         deparse1(substitute( options(unittest.output=tf), list(tf = tf) )),
+         'ok(1==1, "1 equals 1")',
+         'writeLines("Hello")',
+         'stop("erk")',
+         NULL
+     ),
+     11,
+     c(
+         "Hello",
+         NULL
+     ),
+     "Failure outside tests, redirected output"
+ )
ok
> stopifnot(identical(readLines(tf), c(
+     "ok - 1 equals 1",
+     "Bail out! Looks like 1 tests ran, but script ended prematurely",
+     "# Error: erk",
+     "# Traceback:",
+     '#  1: stop("erk")',
+     NULL)))
> 
> # unittest output shouldn't be influenced by the global environment
> run_script(
+     paste(
+         "library(unittest)",
+         "errors <- 'This is not an error, just a string I made'",
+         "ok(1==1, '1 equals 1')",
+         sep = "\n" ),
+     0,
+     c(
+         "ok - 1 equals 1",
+         "1..1",
+         "# Looks like you passed all 1 tests."
+     ),
+     "By setting an errors variable in globalenv we managed to influence unittest output"
+ )
ok
> 
> run_script('
+     library(unittest)
+     options(cli.num_colors = 16)
+     ok(1==1)
+     ok(ut_cmp_equal(as.list(1:2), as.list(1:3)))
+ ', 10, c(
+     "\033[0;1mok - 1 == 1\033[0m",
+     "\033[31;1mnot ok - ut_cmp_equal(as.list(1:2), as.list(1:3))\033[0m",
+     "# Test returned non-TRUE value:",
+     "# Length mismatch: comparison on first 2 components",
+     "# \033[1m--- as.list(1:2)\033[m",
+     "# \033[1m+++ as.list(1:3)\033[m",
+     "# [[1]]\033[m",
+     "# [1] 1\033[m",
+     "# ",
+     "# [[2]]\033[m",
+     "# [1] 2\033[m",
+     "# ",
+     "# \033[32m{+[[3]]+}\033[m",
+     "# \033[32m{+[1] 3+}\033[m",
+     "1..2",
+     "# Looks like you failed 1 of 2 tests.",
+     "# 2: ut_cmp_equal(as.list(1:2), as.list(1:3))",
+     NULL ), "Ok / not ok output colourful if turned on")
ok
> 
> run_script('
+     library(unittest)
+     options(cli.num_colors = 1)
+     ok(1==1)
+     ok(ut_cmp_equal(as.list(1:2), as.list(1:3)))
+ ', 10, c(
+     "ok - 1 == 1",
+     "not ok - ut_cmp_equal(as.list(1:2), as.list(1:3))",
+     "# Test returned non-TRUE value:",
+     "# Length mismatch: comparison on first 2 components",
+     "# --- as.list(1:2)",
+     "# +++ as.list(1:3)",
+     "# [[1]]",
+     "# [1] 1",
+     "# ",
+     "# [[2]]",
+     "# [1] 2",
+     "# ",
+     "# {+[[3]]+}",
+     "# {+[1] 3+}",
+     "1..2",
+     "# Looks like you failed 1 of 2 tests.",
+     "# 2: ut_cmp_equal(as.list(1:2), as.list(1:3))",
+     NULL ), "Ok / not ok output not colourful if turned off")
ok
> 
> proc.time()
   user  system elapsed 
   0.28    0.14    6.78