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. > 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.21 0.09 4.14