expect_error_or_warning在testthat？

Question

我有一些特別挑剔的代碼，在不同的平台上表現不同，但如果在valgrind下運行也表現不同......現在我知道它

• 如果在不在valgrind下的 32位Linux上運行，則會發出警告
• 如果在其他地方運行或在帶有R -d valgrind 32位Linux上運行，則會出錯

下面的代碼工作（抱歉缺少可重現的例子，你可能會發現編寫一個很難）如果我沒有在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")
    }

我想要一個expect_warning_or_error()函數; 我想我可以通過將expect_error和expect_warning的內容expect_error在一起制作一個看起來不太復雜的內容，但我歡迎其他建議。

或者，我可以弄清楚如何檢測我是否在valgrind下運行（似乎更難）。

一種可重復的例子：

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

Answer 1

我的解決方案，從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")
        }
    }
}

Answer 2

@Ben我可能會誤解，但在這里我想到，如果你想知道是否有錯誤/警告，你可以使用tryCatch 。 如果這不是你想要的，或者你希望更多的testthat方法隨意說，“你是標志性的”，但添加一個表情符號:-) ，它會讓一切變得更好。

首先，我創造一種模仿你描述的temperamental功能。 然后我創建一個is.bad函數，只查找錯誤或警告（不要擔心操作系統，因為這種行為很難預測）。 然后我用expect_true或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

我有同樣的問題，在閱讀了兩個函數的源代碼后，我找到了一個很好的解決方案。 實際上非常簡單，你只需要在expect_error的代碼中添加一個小的if語句。

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

在返回值之前添加if語句，檢查是否未引發錯誤並檢查警告（請記住將all參數添加到新函數中）。 新的功能代碼是這樣的：

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

此代碼非常強大且易於維護。 如果你正在編寫一個包並且不能使用未導出的函數（:: :)，你可以將make_label中的代碼帶到函數中，只有一行。