tests/test_ok_group.R

library(unittest)

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))
}

expect_equal <- function (expr, expected) {
    actual <- capture.output(expr)
    if (!identical(all.equal(actual, expected), TRUE)) {
        stop("ok_group output didn't match: ", actual)
    }
}

# Expression printed
expect_equal(ok_group("camels", TRUE), c(
    "# camels"))

# Can have multiple lines in a vector
expect_equal(ok_group(c("camels", "ostriches"), TRUE), c(
    "# camels",
    "# ostriches"))

# Can divide lines with newlines too
expect_equal(ok_group(c("camels\nbadgers\r\nhoney badgers", "ostriches"), FALSE), c(
    "# camels",
    "# badgers",
    "# honey badgers",
    "# ostriches"))

# Expression evaluated after printing section message
expect_equal(ok_group("camels", print("moo")), c(
    "# camels",
    '[1] "moo"'))

# Return NULL
expect_equal({
    if (!is.null(ok_group("camels", 6))) stop("Didn't return NULL")
}, c("# camels"))

run_script('
    library(unittest)
    options(unittest.stop_on_fail = FALSE)
    ok_group("snake", {
        ok(1==1)
        ok(1==2)
        stop("hiss!")
        ok(1==3)
    })
    print("badger")
', 10, c(
    "# snake",
    "ok - 1 == 1",
    "not ok - 1 == 2",
    "# Test returned non-TRUE value:",
    "# [1] FALSE",
    "not ok - ok_group 'snake'",
    "# Exception: hiss!",
    "# Traceback:",
    '#  1: stop("hiss!")',
    '[1] "badger"',
    "1..3",
    "# Looks like you failed 1 of 2 tests.",
    "# 2: 1 == 2",
    "# Looks like 1 groups raised an exception.",
    "# 1: ok_group 'snake'",
    NULL ), "Execution continues after an exception, if stop_on_fail FALSE")

run_script('
    library(unittest)
    options(unittest.stop_on_fail = TRUE)
    ok_group("snake", stop("hiss!"))
    print("badger")
', 11, c(
    "# snake",
    "not ok - ok_group 'snake'",
    "# Exception: hiss!",
    "# Traceback:",
    '#  1: stop("hiss!")',
    "Bail out! Looks like 0 tests ran, but a group failed and unittest.stop_on_fail is set",
    NULL ), "Execution stops after an exception, if stop_on_fail TRUE")

run_script('
    library(unittest)
    options(unittest.stop_on_fail = FALSE)
    ok_group("snake", reptile <- snake)
', 10, c(
    "# snake",
    "not ok - ok_group 'snake'",
    "# Exception: object 'snake' not found",
    "# Traceback:",
    '#  (none)',
    "1..1",
    "# Looks like 1 groups raised an exception.",
    "# 1: ok_group 'snake'",
    NULL ), "Don't output an empty call stack")

Try the unittest package in your browser

Any scripts or data that you put into this service are public.

unittest documentation built on Sept. 11, 2024, 8:38 p.m.