Running 'test_non_interactive.R' [152s]
  Running 'test_ok.R' [0s]
  Running 'test_ok_group.R' [0s]
  Running 'test_options.R' [159s]
  Running 'test_ut_cmp.R' [180s]
  Running 'test_ut_cmp_error.R' [161s]
Running the tests in 'tests/test_non_interactive.R' failed.
Complete output:
  > 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=script,
  +             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, quietly = TRUE)\nok(1==1,\"1 equals 1\")",
  +     0,
  +     c(
  +         "ok - 1 equals 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, quietly = TRUE)\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',
  +         "# Looks like you passed all 1 tests."
  +     ),
  +     "One test one success case not as expected"
  + ) 
  ok
  > 
  > # two tests two sucesses
  > run_script(
  +     "library(unittest, quietly = TRUE)\nok(1==1,\"1 equals 1\")\nok(2==2,\"2 equals 2\")",
  +     0,
  +     c(
  +         "ok - 1 equals 1",
  +         "ok - 2 equals 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, quietly = TRUE)\nok(1!=1,\"1 equals 1\")",
  +     10,
  +     c(
  +         "not ok - 1 equals 1",
  +         "# Test returned non-TRUE value:",
  +         "# [1] FALSE",
  +         "# Looks like you failed 1 of 1 tests."
  +     ),
  +     "One test one failure case not as expected"
  + )
  ok
  > 
  > # four tests two failures 
  > run_script(
  +     "library(unittest, quietly = TRUE)\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",
  +         "# Looks like you failed 2 of 4 tests."
  +     ),
  +     "Four tests two failures case not as expected"
  + )
  ok
  > 
  > # check detaching stops non_interactive_exit functionality
  > run_script(
  +     "library(unittest, quietly = TRUE)\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, quietly = TRUE)\nok(1!=1,\"1 equals 1\")\ndetach(package:unittest,unload=FALSE)\nlibrary(unittest, quietly = TRUE)\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",
  +         "# 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, quietly = TRUE)\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, quietly = TRUE)\nok(1!=1,\"1 equals 1\")\ndetach(package:unittest,unload=TRUE)\nlibrary(unittest, quietly = TRUE)\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",
  +         "# 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
  > 
  > # Failure outside test
  > run_script(
  +     paste(
  +         "library(unittest, quietly = TRUE)",
  +         "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 passed, but script ended prematurely",
  +         "# Error: eek",
  +         "# ook",
  +         "# Traceback:",
  +         "# 1:",
  +         '# stop("eek\\nook")',
  +         NULL
  +     ),
  +     "Failure outside tests"
  + )
  ok
  > 
  > # tryCatch() doesn't count as failure
  > run_script(
  +     paste(
  +         "library(unittest, quietly = TRUE)",
  +         "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",
  +         "# Looks like you passed all 2 tests.",
  +         NULL
  +     ),
  +     "Caught errors outside tests"
  + )
  ok
  > 
  > proc.time()
     user  system elapsed 
     0.15    0.09    3.46 
Running the tests in 'tests/test_options.R' failed.
Complete output:
  > library(unittest, quietly = TRUE)
  > 
  > expect_equal <- function (expr, expected) {
  +     actual <- capture.output(expr)
  +     if (!identical(all.equal(actual, as.character(expected)), TRUE)) {
  +         str(actual, vec.len = 10000)
  +         stop("output didn't match: ", actual)
  +     }
  + }
  > 
  > # NB: In an interactive session, the state of unittest isn't guaranteed
  > if (!interactive()) {
  +     # By default, output in stdout
  +     expect_equal({
  +         ok_group("Some tests", {
  +             ok(ut_cmp_equal(4, 5), "4 == 5? Probably not")
  +         })
  +     }, c(
  +         "# Some tests",
  +         "not ok - 4 == 5? Probably not",
  +         "# Test returned non-TRUE value:",
  +         "# Mean relative difference: 0.25",
  +         "# --- 4",
  +         "# +++ 5",
  +         "# [1] [-4-]{+5+}"))
  + }
  > 
  > # Redirect to tempfile, output ended up there
  > tf <- tempfile()
  > options(unittest.output = tf)
  > expect_equal({
  +     ok_group("Some tests", {
  +         ok(ut_cmp_equal(5, 6), "5 == 6? Probably not")
  +     })
  + }, c())
  > expect_equal(writeLines(readLines(tf)), c(
  +     "# Some tests",
  +     "not ok - 5 == 6? Probably not",
  +     "# Test returned non-TRUE value:",
  +     "# Mean relative difference: 0.2",
  +     "# --- 5",
  +     "# +++ 6",
  +     "# [1] [-5-]{+6+}"))
  > 
  > # Send back to stdout
  > options(unittest.output = NULL)
  > expect_equal({
  +     ok_group("Some tests", {
  +         ok(ut_cmp_equal(8, 9), "8 == 9? Probably not")
  +     })
  + }, c(
  +     "# Some tests",
  +     "not ok - 8 == 9? Probably not",
  +     "# Test returned non-TRUE value:",
  +     "# Mean relative difference: 0.125",
  +     "# --- 8",
  +     "# +++ 9",
  +     "# [1] [-8-]{+9+}"))
  > 
  > test_output_ansi_color <- function (x) {
  +     old_env <- c("NO_COLOR", "R_CLI_NUM_COLORS") ; names(old_env) <- old_env
  +     old_env <- lapply(old_env, Sys.getenv)
  +     on.exit(do.call(Sys.setenv, old_env))
  + 
  +     old_opts <- c("cli.num_colors") ; names(old_opts) <- old_opts
  +     old_opts <- lapply(old_opts, getOption)
  +     on.exit(do.call(options, old_opts))
  + 
  +     Sys.unsetenv(c("NO_COLOR", "R_CLI_NUM_COLORS"))
  +     options("cli.num_colors" = NULL)
  + 
  +     x
  + }
  > 
  > test_output_ansi_color({
  +     Sys.setenv(NO_COLOR=1)
  +     stopifnot(isFALSE(unittest:::output_ansi_color()))
  + })
  > 
  > test_output_ansi_color({
  +     Sys.setenv(R_CLI_NUM_COLORS=8)
  +     stopifnot(isTRUE(unittest:::output_ansi_color()))
  + })
  > test_output_ansi_color({
  +     Sys.setenv(R_CLI_NUM_COLORS=1)
  +     stopifnot(isFALSE(unittest:::output_ansi_color()))
  + })
  > 
  > test_output_ansi_color({
  +     options("cli.num_colors" = 8)
  +     stopifnot(isTRUE(unittest:::output_ansi_color()))
  + })
  > test_output_ansi_color({
  +     options("cli.num_colors" = 1)
  +     stopifnot(isFALSE(unittest:::output_ansi_color()))
  + })
  > 
  > # Clear results of expected test failures
  > if (!interactive()) rm('outcomes', pos = unittest:::pkg_vars)
  > 
  > proc.time()
     user  system elapsed 
     0.21    0.12    0.96 
Running the tests in 'tests/test_ut_cmp.R' failed.
Complete output:
  > options(useFancyQuotes = FALSE)  # Force to stabilise all.equal output
  > 
  > library(unittest)
  > 
  > # Compare character output of a (failing) cmp function, ignoring colors
  > cmp_lines <- function (actual, ...) {
  +     # Remove color escape codes
  +     no_color <- gsub('\033\\[.*?m', '', actual, perl = TRUE)
  +     if(identical(no_color, c(...)[!is.null(c(...))])) {
  +         return(TRUE)
  +     }
  +     # utils::str(no_color, vec.len = 1000, digits.d = 5, nchar.max = 1000)
  +     return(c(c(...)[!is.null(c(...))], '----', actual))
  + }
  > 
  > # Mock (fn) in namespace with (replacement) whilst (block) is being evaluated
  > mock <- function (fn, replacement, block) {
  +     # Get the name of the function from the unevaluated argument,
  +     # assuming it's of the form package::name
  +     fn_name <- as.character(as.list(sys.call()[[2]])[[3]])
  +     ns <- environment(fn)
  + 
  +     orig_fn <- get(fn_name, env = ns)
  +     unlockBinding(fn_name, env = ns)
  +     assign(fn_name, replacement, envir = ns)
  +     on.exit(assign(fn_name, orig_fn, envir = ns), add = TRUE)
  + 
  +     block
  + }
  > 
  > ok_group("ut_cmp_equal", (function () {
  +     ok(isTRUE(ut_cmp_equal(4, 4)), "Identical objects return true")
  +     ok(isTRUE(ut_cmp_equal(as.integer(4), 4)), "Equivalent objects return true (i.e. integer vs. number)")
  +     ok(isTRUE(ut_cmp_equal(0.01, 0.02, tolerance = 0.1)), "Additional arguments passed through to all.equal")
  + 
  +     if (!file.exists(unittest:::git_binary())) {
  +         ok(TRUE, "# skip git not available")
  +         return()
  +     }
  + 
  +     ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
  +         'Mean relative difference: 1',
  +         '--- c(2, 4, 2, 8)',
  +         '+++ c(5, 4, 2, 1)',
  +         '[1] [-2-]{+5+} 4 2 [-8-]{+1+}',
  +         NULL), "Vectors filtered by str, individual differences highlighted")
  + 
  +     ok(!withVisible(ut_cmp_equal("apples", "oranges"))$visible,
  +         "Output of comparision isn't visible (we should print it at a real console though)")
  + 
  +     do_a_thing <- function (x) seq(x)
  +     ok(cmp_lines(ut_cmp_equal(do_a_thing(4), do_a_thing(1 + 2)),
  +         'Numeric: lengths (4, 3) differ',
  +         '--- do_a_thing(4)',
  +         '+++ do_a_thing(1 + 2)',
  +         '[1] 1 2 3[-4-]',
  +         NULL), "The ---/+++ lines show expressions handed to ut_cmp_equal()")
  + 
  +     ok(cmp_lines(ut_cmp_equal(list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13), list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)),
  +         "Component 1: Mean relative difference: 0.625",
  +         "--- list(c(1, 2, 8), c(2, 3, 2), 10, 11, 12, 13)",
  +         "+++ list(c(1, 2, 3), c(2, 3, 2), 10, 11, 12, 13)",
  +         "[[1]]",
  +         "[1] 1 2 [-8-]{+3+}",
  +         "",
  +         "[[2]]",
  +         "[1] 2 3 2",
  +         "",
  +         "[[3]]",
  +         "[1] 10",
  +         "",
  +         "[[4]]",
  +         "[1] 11",
  +         "",
  +         "[[5]]",
  +         "[1] 12",
  +         "",
  +         "[[6]]",
  +         "[1] 13",
  +         NULL), "We return the whole file as context, not just the usual 3 lines")
  +     
  +     ok(cmp_lines(ut_cmp_equal(c("'Ouch!' he said,", "it was an iron bar."), c("Ooops!", "it was an accident.")),
  +         '2 string mismatches',
  +         '--- c("\'Ouch!\' he said,", "it was an iron bar.")',
  +         '+++ c("Ooops!", "it was an accident.")',
  +         "[-'Ouch!' he said,-]{+Ooops!+}",
  +         'it was an [-iron bar.-]{+accident.+}',
  +         NULL), "Character vectors get compared one per line")
  + 
  +     ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
  +         'Length mismatch: comparison on first 2 components',
  +         'Component "a": Mean relative difference: 0.6666667',
  +         '--- as.environment(list(a = 3, b = 4))',
  +         '+++ as.environment(list(a = 5, b = 4, c = 9))',
  +         '{+$c+}',
  +         '{+[1] 9+}',
  +         '',
  +         '$b',
  +         '[1] 4',
  +         '',
  +         '$a',
  +         '[1] [-3-]{+5+}',
  +         NULL), "Environments get converted to lists")
  + 
  +     cmp_helper <- function (a, b) ut_cmp_equal(a, b, deparse_frame = -2)
  +     ok(cmp_lines(cmp_helper(2, 8),
  +         'Mean relative difference: 3',
  +         '--- 2',
  +         '+++ 8',
  +         '[1] [-2-]{+8+}',
  +         NULL), "A helper function can up deparse_frame to improve output")
  + })())
  # ut_cmp_equal
  ok - Identical objects return true
  ok - Equivalent objects return true (i.e. integer vs. number)
  ok - Additional arguments passed through to all.equal
  ok - Vectors filtered by str, individual differences highlighted
  ok - Output of comparision isn't visible (we should print it at a real console though)
  ok - The ---/+++ lines show expressions handed to ut_cmp_equal()
  ok - We return the whole file as context, not just the usual 3 lines
  ok - Character vectors get compared one per line
  ok - Environments get converted to lists
  ok - A helper function can up deparse_frame to improve output
  > 
  > # Mock git_binary(), so we don't find git even if it is available
  > ok_group("ut_cmp_equal:nogit", mock(unittest:::git_binary, function () "/not-here", {
  +     ok(cmp_lines(ut_cmp_equal(c(2,4,2,8), c(5,4,2,1)),
  +         'Mean relative difference: 1',
  +         '--- c(2, 4, 2, 8)',
  +         '[1] 2 4 2 8',
  +         '+++ c(5, 4, 2, 1)',
  +         '[1] 5 4 2 1',
  +         NULL), "No git available, so show outputs side by side")
  + 
  +     ok(cmp_lines(ut_cmp_equal(as.environment(list(a=3, b=4)), as.environment(list(a=5, b=4, c=9))),
  +         'Length mismatch: comparison on first 2 components',
  +         'Component "a": Mean relative difference: 0.6666667',
  +         '--- as.environment(list(a = 3, b = 4))',
  +         '$b',
  +         '[1] 4',
  +         '',
  +         '$a',
  +         '[1] 3',
  +         '',
  +         '+++ as.environment(list(a = 5, b = 4, c = 9))',
  +         '$c',
  +         '[1] 9',
  +         '',
  +         '$b',
  +         '[1] 4',
  +         '',
  +         '$a',
  +         '[1] 5',
  +         '',
  +         NULL), "Environments get converted to lists")
  + }))
  # ut_cmp_equal:nogit
  ok - No git available, so show outputs side by side
  ok - Environments get converted to lists
  > 
  > ok_group("ut_cmp_identical", (function () {
  +     if (!file.exists(unittest:::git_binary())) {
  +         ok(TRUE, "# skip git not available")
  +         return()
  +     }
  + 
  +     ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
  +     ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
  +         '--- as.integer(4)',
  +         '+++ 4',
  +         ' [-int-]{+num+} 4',
  +         NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
  + 
  +     # NB: On r-oldrel-windows-ix86+x86_64 this produces 1.0000000001,
  +     #     not 1.000000000100000008274, regardless expecting this much
  +     #     numerical consistency is a bit enthusiastic.
  +     ok(cmp_lines(gsub("1.0000000001[0-9]+", "1.0000000001", ut_cmp_identical(1, 1 + 1e-10)),
  +         '--- 1',
  +         '+++ 1 + 1e-10',
  +         ' num [-1-]{+1.0000000001+}',
  +         NULL), "Increase str() digits to 22 show a difference")
  + 
  +     ok(cmp_lines(ut_cmp_identical(1 + 1e-10, 1 + 1e-7),
  +         '--- 1 + 1e-10',
  +         '+++ 1 + 1e-07',
  +         ' num [-1-]{+1.0000001+}',
  +         NULL), "Increase str() digits (7 is enough) show a difference")
  + 
  +     cmp_helper <- function (a, b) ut_cmp_identical(a, b, deparse_frame = -2)
  +     ok(cmp_lines(cmp_helper(2, 8),
  +         '--- 2',
  +         '+++ 8',
  +         '[1] [-2-]{+8+}',
  +         NULL), "A helper function can up deparse_frame to improve output")
  + })())
  # ut_cmp_identical
  ok - Identical objects return true
  ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
  ok - Increase str() digits to 22 show a difference
  ok - Increase str() digits (7 is enough) show a difference
  ok - A helper function can up deparse_frame to improve output
  > 
  > ok_group("output_diff", (function () {
  +     if (!file.exists(unittest:::git_binary())) {
  +         ok(TRUE, "# skip git not available")
  +         return()
  +     }
  + 
  +     options("cli.num_colors" = 256)
  +     ok(any(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (escape code in output)")
  + 
  +     options("cli.num_colors" = 1)
  +     ok(!all(grepl('\033\\[.*?m', ut_cmp_identical(1L, 2L), perl = TRUE)), "cli.num_colors honoured (no escape code in output)")
  + })())
  # output_diff
  ok - cli.num_colors honoured (escape code in output)
  ok - cli.num_colors honoured (no escape code in output)
  > 
  > ok_group("ut_cmp_identical:nogit", mock(unittest:::git_binary, function () "/not-here", {
  +     ok(isTRUE(ut_cmp_identical(4, 4)), "Identical objects return true")
  +     ok(cmp_lines(ut_cmp_identical(as.integer(4), 4),
  +         '--- as.integer(4)',
  +         ' int 4',
  +         '+++ 4',
  +         ' num 4',
  +         NULL), "Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output")
  + }))
  # ut_cmp_identical:nogit
  ok - Identical objects return true
  ok - Equivalent objects do not, unlike ut_cmp_equal(). We also fall back to using str(), as print() will produce identical output
  > 
  > proc.time()
     user  system elapsed 
     0.21    0.12    4.42 
Running the tests in 'tests/test_ut_cmp_error.R' failed.
Complete output:
  > library(unittest)
  > 
  > ok_group("ut_cmp_error", {
  +     ok(isTRUE(ut_cmp_error(stop("Erk"), "Erk")), "Error caught and compared")
  +     ok(ut_cmp_error(2 + 2, "error") == "No error returned", "No error results in a message (even though we would have matched message with regex)")
  +     
  +     ok(isTRUE(ut_cmp_error(stop("Erk"), "E.+k")), "Comparison is a regex")
  +     ok(!isTRUE(ut_cmp_error(stop("Erk"), "E.+k", fixed = TRUE)), "... turned off with fixed")
  + 
  +     ok(!isTRUE(ut_cmp_error(stop("Erk"), "e.+k")), "Case sensitive by default")
  +     ok(isTRUE(ut_cmp_error(stop("Erk"), "e.+k", ignore.case = TRUE)), "... turned off with ignore.case")
  + })
  # ut_cmp_error
  ok - Error caught and compared
  ok - No error results in a message (even though we would have matched message with regex)
  ok - Comparison is a regex
  ok - ... turned off with fixed
  ok - Case sensitive by default
  ok - ... turned off with ignore.case
  > 
  > proc.time()
     user  system elapsed 
     0.17    0.09    0.20