5

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

3 回答 3

6

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")
        }
    }
}
于 2014-06-17T01:46:40.123 回答
3

@Ben我可能会误解，但在这里我想到，如果你想知道是否有错误/警告，你可以使用tryCatch. 如果这不是您想要的，或者您希望有更多的testthat方法，请随意说，“你的方式很不错”，但添加一个类似的表情符号:-)，它会让一切变得更好。

首先，我制作了一个temperamental函数来模仿您所描述的内容。然后我创建一个is.bad函数并查找错误或警告（不要担心操作系统，因为这种行为很难预测）。然后我用expect_trueor换行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)))
于 2014-06-17T00:35:44.793 回答
1

我遇到了同样的问题，在阅读了这两个函数的源代码后，我找到了一个很好的解决方案。其实很简单，你只需要在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 带到函数中，只有一行。

于 2017-03-27T01:21:46.913 回答