2

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

Siete
  • 328
  • 3
  • 14

1 Answers1

0

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 = mypackage::sum(5,5),  # some imaginary exported functions sum and name.
           check2 = mypackage::name()
        )
    }
)
test_that('My test case', {
    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()

        # Defining helper functions
        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)
        }

        # Performing the tests
        .exp_match('My name is Siete', 'My name is .*')
        .exp_equal(mypackage::sum(5,5), 10)  # some imaginary exported functions sum and name.
        .exp_match(mypackage::name(), 'Siete')
    
        .exp_false('package:testthat' %in% search())

        return(tst)
    },
    show = TRUE)

# Performing the actual testthat tests:
.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()
}

It works as follows:

  • An empty list is created: tst
  • By calling .exp_... functions, tests are added to that list
  • The list with tests is returned by the function in callr::r
  • Then we loop over the list and execute every test
Siete
  • 328
  • 3
  • 14