R Under development (unstable) (2024-01-07 r85787 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.

> #
> # Note:
> #    None of these tests produce any output on success
> #
> 
> 
> library(unittest, quietly = TRUE)
> 
> 
> # -----
> # setup
> # -----
> 
> expect_success <- function( ok_call ) {
+     output <- paste(capture.output(ok_call), collapse = " ")
+     if(! grepl(x = output, pattern='^ok -', perl=TRUE)) {
+         stop(paste('expected success, got: ', output)) 
+     }
+     invisible(TRUE)
+ }
> 
> expect_failure <- function(ok_call, exp_fail_regex = NULL) {
+     output <- paste(capture.output(ok_call), collapse = "\n")
+     if(! grepl(x = output, pattern='^not ok -', perl=TRUE)) {
+         stop(paste('expected failure, got: ', output)) 
+     }
+     if(! is.null(exp_fail_regex)) {
+         if(! grepl(x = output, pattern = exp_fail_regex, perl=TRUE)) {
+             stop(paste('\'exp_fail_regex\' did not match. Got: ', output, sep = ""))
+         }
+     }
+     invisible(TRUE)
+ }
> 
> expect_error <- function(ok_call, exp_err_regex = NULL) {
+     msg <- tryCatch({ok_call ; "No error returned"}, error = function(e) e$message)
+     if(!grepl(exp_err_regex, msg)) {
+         stop("'", msg, "' should contain '", exp_err_regex, "'")
+     }
+ }
> 
> regex_escape <- function (x) {
+     gsub("([.|()\\^{}+$*?]|\\[|\\])", "\\\\\\1", x)
+ }
> 
> # -----------------
> # test invalid uses
> # -----------------
> 
> expect_error(
+     ok(TRUE, 5),
+     '\'description\' must be of type \'chr\''
+ )
> 
> expect_error(
+     ok(TRUE, c("Lots", "of", "string")),
+     '\'description\' must be of type \'chr\''
+ )
> 
> # ------------
> # test success
> # ------------
> 
> expect_success(
+     ok(TRUE, "true")
+ )
> expect_success(
+     ok(1==1, "one equals one")
+ )
> 
> expect_success(
+     ok(all.equal(c(1,2), c(1,2)), "one and two are the same")
+ )
> 
> expect_success(
+     ok(all(1==1, 2==2), "one and two are still the same")
+ )
> 
> 
> # ------------
> # test failure
> # ------------
> 
> expect_failure(
+     ok(1==2, "one equals two"),
+     '# \\[1\\] FALSE'
+ )
> 
> # all.equal(...) works and sees past the first element
> expect_failure(
+     ok(all.equal(c(1,2), c(1,4)), "one equals one, and two equals four"),
+     '# Mean relative difference: 1'
+ )
> 
> # on an error, we display the error and the failing call
> fn <- function(x) {
+     stop("Oh no")
+ }
> complex_call <- function(...) {
+     fn(badgers)
+ }
> expect_failure(
+     ok(fn(5), "Function that returns error"),
+     'Oh no(.|\n)*fn\\(5\\)'
+ )
> expect_failure(
+     ok(complex_call(badgers = "yes", locations = c("Bungay", "Milton Keynes", "Hearne Bay", "Wigan")), "Multi-line stacktrace"),
+     paste(
+         regex_escape('# -> complex_call(badgers = "yes", locations = c("Bungay", "Milton Keynes", '),
+         regex_escape('#     "Hearne Bay", "Wigan"))'),
+         regex_escape('# -> fn(badgers)'),
+         regex_escape('# -> stop("Oh no")'),
+         sep = '\\n', collapse = '\\n'
+     )
+ )
> 
> # Stacktrace not thwarted by closure
> expect_failure(
+     do.call(function (x) {ok(stop("erk"), "Test fails")}, list(1)),
+     paste(
+         regex_escape('# Stacktrace:'),
+         regex_escape('# -> stop("erk")'),
+         sep = '\\n', collapse = '\\n'
+     )
+ )
> 
> # Stacktrace not thwarted by unittest::ok
> expect_failure(
+     unittest::ok(complex_call(badgers = "yes"), "Calling unittest::ok"),
+     paste(
+         regex_escape('# -> complex_call(badgers = "yes")'),
+         regex_escape('# -> fn(badgers)'),
+         regex_escape('# -> stop("Oh no")'),
+         sep = '\\n', collapse = '\\n'
+     )
+ )
> 
> # ------------------------
> # Only TRUE counts as true
> # ------------------------
> 
> expect_failure(
+     ok(c(1,2)==c(1,3), "directly compare vector"),
+     '# Test returned non-TRUE value:\n# \\[1\\]  TRUE FALSE'
+ )
> 
> expect_success(
+     ok(TRUE, "truth")
+ )
> 
> expect_failure(
+     ok(c(TRUE, TRUE), "too much truth"),
+     "# Test returned non-TRUE value:\n# \\[1\\] TRUE TRUE"
+ )
> 
> expect_failure(
+     ok(1, "he may be the one but he is not truth"),
+     '# Test returned non-TRUE value:\n# \\[1\\] 1'
+ )
> 
> expect_failure(
+     ok("1", "quoted one"),
+     '# Test returned non-TRUE value:\n# 1'
+ )
> 
> expect_failure(
+     ok("TRUE", "quoted truth"),
+     '# Test returned non-TRUE value:\n# TRUE'
+ )
> 
> # -------------------
> # default description
> # -------------------
> 
> printed <- capture.output( ok( 3==3 ) )
> if(! grepl(x = printed, pattern = '3\\s*==\\s*3', perl=TRUE)) {
+     stop("ok() without description looks broken")
+ }
> 
> # ---------------------------------
> # Character vectors are shown as-is
> # ---------------------------------
> 
> expect_failure(
+     ok(c("Site is silent, yes", "No voices can be heard now", "The cows roll their eyes."), "haiku"),
+     '# Test returned non-TRUE value:\n# Site is silent, yes\n# No voices can be heard now\n# The cows roll their eyes.'
+ )
> 
> expect_failure(
+     ok(c("Login incorrect.\nOnly perfect spellers may", "Enter this system."), "some newlines"),
+     '# Test returned non-TRUE value:\n# Login incorrect.\n# Only perfect spellers may\n# Enter this system.'
+ )
> 
> expect_failure(
+     ok("A file that big?\nIt might be very useful\nBut now it is gone.", "all newlines"),
+     '# Test returned non-TRUE value:\n# A file that big\\?\n# It might be very useful\n# But now it is gone.'
+ )
> 
> expect_failure(
+     ok(c("A file that big?\n\nIt might be very useful", "", "But now it is gone."), "empty lines inbetween"),
+     '# Test returned non-TRUE value:\n# A file that big\\?\n# \n# It might be very useful\n# \n# But now it is gone.'
+ )
> 
> # ------------
> # return value
> # ------------
> 
> dev_null <- capture.output(rv <- ok(2==2, "two equals two"))  # nothing else prints so neither should this
> if( ! identical(rv, TRUE) ) {
+     stop("ok() return value looks wrong")
+ }
> 
> 
> # ================================
> # if we are being run by CMD check
> # ================================
> 
> if(! interactive()) {
+     
+     # we stored some results
+     # this will fail if 'outcomes' does not exist
+     get('outcomes', pos = unittest:::pkg_vars)
+ 
+     # clean up
+     # Remove outcomes, so we don't try and report actual failures
+     rm('outcomes', pos = unittest:::pkg_vars)
+ 
+ }
> 
> 
> proc.time()
   user  system elapsed 
   0.25    0.14    0.37