expect_error_or_warning in testthat?

Question

I have some particularly finicky code that behaves differently on different platforms, but also behaves differently if run under valgrind ... right now I know that it

• gives a warning if run on 32-bit Linux not under valgrind
• gives an error if run elsewhere or on 32-bit Linux with R -d valgrind

The code below works (sorry for the lack of reproducible example, you can probably see that it would be pretty hard to write one) if I'm not running under valgrind, but under valgrind it fails because we get an error rather than a warning.

 if (sessionInfo()$platform=="i686-pc-linux-gnu (32-bit)") {
        expect_warning(update(g0, .~. +year), "failed to converge")
    } else {
        expect_error(update(g0, .~. +year), "pwrssUpdate did not converge in")
    }

I would like an expect_warning_or_error() function; I suppose I could make one by hacking together the guts of expect_error and expect_warning, which don't look too complicated, but I welcome other suggestions.

Alternatively, I could figure out how to detect whether I am running under valgrind or not (seems harder).

A sort-of reproducible example:

 library(testthat)
 for (i in c("warning","stop")) {
    expect_warning(get(i)("foo"))
    expect_error(get(i)("foo"))
 }

Answer 1

My solution, hacked together from gives_warning() and throws_error(). I'm not sure it's completely idiomatic/robust ...

gives_error_or_warning <- function (regexp = NULL, all = FALSE, ...) 
{
    function(expr) {
        res <- try(evaluate_promise(expr),silent=TRUE)
        no_error <- !inherits(res, "try-error")
        if (no_error) {
            warnings <- res$warnings

            if (!is.null(regexp) && length(warnings) > 0) {
                return(matches(regexp, all = FALSE, ...)(warnings))
            } else {
                return(expectation(length(warnings) > 0, "no warnings or errors given", 
                            paste0(length(warnings), " warnings created")))
            }
        }
        if (!is.null(regexp)) {
            return(matches(regexp, ...)(res))
        }
        else {
            expectation(TRUE, "no error thrown", "threw an error")
        }
    }
}

Answer 2

@Ben I may be misunderstanding but it comes to mind here that if you want to know if something errored/warned or not you could use tryCatch. If this is not what you want or you were hoping for a more testthat approach feel free to say, "You're way of the mark" but add an emoticon like :-) and it will make everything better.

First I make a temperamental function to mimic what you describe. Then I make an is.bad function and just look for errors or warnings (don't worry about OS as this behavior is hard to predict). Then I wrap with expect_true or expect_false:

temperamental <- function(x) {
    if (missing(x)){
        ifelse(sample(c(TRUE, FALSE), 1), stop("Robot attack"), warning("Beware of bots!"))
    } else {
        x
    }
}

temperamental()
temperamental(5)

is.bad <- function(code) {
    isTRUE(tryCatch(code,
        error = function(c) TRUE,
        warning = function(c) TRUE
    ))
}

expect_true(is.bad(temperamental()))
expect_false(is.bad(temperamental(5)))

Answer 3

I had the same problem and after reading the source for both functions I found a good solution. Actually is very simple, you only need to add a small if statement in the code from expect_error.

This is the code from expect_error

function (object, regexp = NULL, ..., info = NULL, label = NULL) 
{
    lab <- make_label(object, label)
    error <- tryCatch({
        object
        NULL
    }, error = function(e) {
        e
    })
    if (identical(regexp, NA)) {
        expect(is.null(error), sprintf("%s threw an error.\n%s", 
                                       lab, error$message), info = info)
    }
    else if (is.null(regexp) || is.null(error)) {
        expect(!is.null(error), sprintf("%s did not throw an error.", 
                                        lab), info = info)
    }
    else {
        expect_match(error$message, regexp, ..., info = info)
    }
    invisible(NULL)
}

Adding an if statement before the return value you check if an error was not thrown and check for warnings (remember to add the all argument to the new function). The new function code is this:

expect_error_or_warning <- function (object, regexp = NULL, ..., info = NULL, label = NULL, all = FALSE) 
{
    lab <- testthat:::make_label(object, label)
    error <- tryCatch({
        object
        NULL
    }, error = function(e) {
        e
    })

    if (identical(regexp, NA)) {
        expect(is.null(error), sprintf("%s threw an error.\n%s", 
                                       lab, error$message), info = info)
    } else if (is.null(regexp) || is.null(error)) {
        expect(!is.null(error), sprintf("%s did not throw an error.", 
                                        lab), info = info)
    } else {
        expect_match(error$message, regexp, ..., info = info)
    }

    if(is.null(error)){
        expect_warning(object = object, regexp = regexp, ...,  all = all, info = info, label = label)
    }
    invisible(NULL)
}

This code is very robust and easy to maintain. If you are writing a package and can't use functions that aren't exported (:::) you can bring the code from make_label to the function, is only one line.