Nothing
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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
# 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"
)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.