expect_error_or_warning在testthat?

Ben*_*ker 5 unit-testing r testthat

我有一些特别挑剔的代码,在不同的平台上表现不同,但如果在valgrind... 下运行也会表现不同我现在知道它

  • 如果在不在valgrind下的 32位Linux上运行,则会发出警告
  • 如果在其他地方运行或在32位Linux上运行,则会出错R -d valgrind

下面的代码工作(抱歉缺少可重现的例子,你可能会发现编写一个很难),如果我没有运行valgrind,但是valgrind由于我们得到错误而不是警告而失败.

 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")
    }
Run Code Online (Sandbox Code Playgroud)

我想要一个expect_warning_or_error()功能; 我想我可以通过黑客攻击,expect_error并且expect_warning看起来并不太复杂,但我欢迎其他建议.

或者,我可以弄清楚如何检测我是否正在运行valgrind(似乎更难).

一种可重复的例子:

 library(testthat)
 for (i in c("warning","stop")) {
    expect_warning(get(i)("foo"))
    expect_error(get(i)("foo"))
 }
Run Code Online (Sandbox Code Playgroud)

Ben*_*ker 5

我的解决方案,从gives_warning()和throws_error().我不确定它是完全惯用的还是健壮的......

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")
        }
    }
}
Run Code Online (Sandbox Code Playgroud)