在单独的 R session 中运行 testthat 测试（如何组合结果）

Question

I need to test package loading operations (for my multiversion package ) and know that unloading namespaces and stuff is dangerous work. So I want to run every test in a fresh R session. Running my tests in parallel does not meet this demand since it will reuse slaves, and these get dirty.

So I thought callr::r would help me out. Unfortunately I am again stuck with the minimally documented reporters it seems.

The following is a minimal example. Placed in file test-mytest.R .

test_that('test 1', {
    expect_equal(2+2, 5)
})

reporter_in <- testthat::get_reporter()

# -- 1 --

reporter_out <- callr::r(

    function(reporter) {
        
        reporter <- testthat::with_reporter(reporter, {

           testthat::test_that("test inside", {
              testthat::expect_equal('this', 'wont match')
           })
       })
    },
    args = list(reporter = reporter_in),
    show = TRUE
)

# -- 2 --
testthat::set_reporter(reporter_out)

# -- 3 --
test_that('test 2', {
    expect_equal(2+2, 8)
})

I called this test file using:

# to be able to check the outcome, work with a specific reporter
summary <- testthat::SummaryReporter$new()
testthat::test_file('./tests/testthat/test-mytest.R', reporter = summary)

Which seems to do what I want, but when looking at the results...

> summary$end_reporter()

== Failed ===============================================================================================
-- 1. Failure (test-load_b_pick_last_true.R:5:5): test 1 ------------------------------------------------
2 + 2 (`actual`) not equal to 5 (`expected`).

  `actual`: 4
`expected`: 5

== DONE =================================================================================================

...it is only the first test that is returned.

How it works:

• An ordinary test is executed.
• The reporter, currently in use, is obtained ( -- 1 -- )
• callr::r is used to call a testthat block including a test.
• Within the call, I tried using set_reporter , but with_reporter is practically identical.
• The callr::r call returns the reporter (tried it with get_reporter() , but with_reporter also returns the reporter (invisibly))

Now the returned reporter seems fine, but when setting it as the actual reporter with set_reporter , it seems that it is not overwriting the actual reporter.

Note that at -- 2 -- , the reporter_out contains both test outcomes.

Question

I am not really sure what I expect it to do, but in the end I want the results to be added to the original reporter (( summary or) reporter_in that is, if that is not some kind of copy).

Answer 1

One workaround I can think of would be to move the actual test execution outside of the callr::r call, but gather the testcases inside. I think it is neat, as long as you can place these helper functions (see the elaborate example) in your package , you can write tests with little overhead.

It doesn't answer how to work with the 'reporter' object though...

Simple example:

test_outcome <- callr::r(
    function() {
        # devtools::load_all()
        list(
           check1 = 5+5,
           check2 = 'my name'
        )
    }
)
test_that(test_outcome$desc, {
    expect_equal(test_outcome$check1, 10)
    expect_equal(test_outcome$check2, 'Siete')
})

Elaborate example

Note that from .add_test to .exp_true are only function definitions which can better be included in your package so they will be available when being loaded with devtools::load_all() . load_all also loads not-exported functions by default.

test_outcome <- callr::r(
    function() {
        # devtools::load_all()

        tst <- list(desc = 'My first test', tests = list())

        .add_test <- function(type, A, B) {
            # To show at least something about what is actually tested when returning the result, we can add the actual `.exp_...` call to the test.
            call <- as.character(sys.call(-1))

            tst$tests[[length(tst$tests) + 1]] <<- list(
                type = type, a = A, b = B,
                # (I couldn't find a better way to create a nice call string)
                call = paste0(call[1], '(', paste0(collapse = ', ', call[2:length(call)]), ')'))
        }
        .exp_error <- function(expr, exp_msg) {
            err_msg <- ''
            tryCatch({expr}, error = function(err) {
                err_msg <<- err$message
            })
            .add_test('error', err_msg, exp_msg)
        }
        .exp_match <- function(expr, regex) {
            .add_test('match', expr, regex)
        }
        .exp_equal <- function(expr, ref) {
            .add_test('equal', expr, ref)
        }
        .exp_false <- function(expr) {
            .add_test('false', expr, FALSE)
        }
        .exp_true <- function(expr) {
            .add_test('true', expr, TRUE)
        }

        .exp_match('My name is Siete', 'My name is .*')
        .exp_equal(5+5, 10)
        .exp_false('package:testthat' %in% search())

        return(tst)
    },
    show = TRUE)


.run_test_batch <- function(test_outcome) {
    test_that(test_outcome$desc, {
        for (test in test_outcome$tests) {
            # 'test' is a list with the fields 'type', 'a', 'b' and 'call'.
            # Where 'type' can contain 'match', 'error', 'true', 'false' or 'equal'.
            if (test$type == 'equal') {
                with(test, expect_equal(a, b, label = call))
            } else if (test$type == 'true') {
                expect_true( test$a, label = test$call)
            } else if (test$type == 'false') {
                expect_false(test$a, label = test$call)
            } else if (test$type %in% c('match', 'error')) {
                with(test, expect_match(a, b, label = call))
            }
        }
    })
}

.run_test_batch(test_outcome)

When moving the functions to your package you would need the following initialize function too.

tst <- new.env(parent = emptyenv())
tst$desc = ''
tst$tests = list()

.initialize_test <- function(desc) {
    tst$desc = desc
    tst$tests = list()
}