expect_error_or_warning in testdas? wenn laufen auf 32-Bit-Linux-

Question

Ich habe einige besonders pingelig Code, der auf verschiedenen Plattformen unterschiedlich verhält, sondern auch verhält sich anders laufen, wenn unter valgrind ... jetzt weiß ich, dass es

• eine Warnung gibt nicht unter valgrind
• gibt einen Fehler, wenn an anderer Stelle oder auf 32-Bit-Linux liefen mit R -d valgrind

den folgenden Code über Werke (sorry für den Mangel an repr Wenn Sie nicht unter valgrind laufen, aber unter valgrind schlägt es fehl, weil wir einen Fehler statt einer Warnung erhalten.

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

Ich möchte eine expect_warning_or_error() Funktion; Ich nehme an, ich könnte einen machen, indem ich zusammen die Eingeweide von expect_error und expect_warning hacken, die nicht kompliziert aussehen, aber andere Vorschläge begrüßen.

Alternativ könnte ich herausfinden, wie ich feststellen kann, ob ich unter valgrind oder nicht (scheint härter) läuft.

Ein Art-reproduzierbaren Beispiel:

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

Answer 1

Meine Lösung, gehackt zusammen aus gives_warning() und throws_error(). Ich bin mir nicht sicher, dass es vollständig idiomatisches/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 ich Missverständnis sein kann, aber es kommt hier in dem Sinne, wenn Sie wissen wollen, ob etwas errored/gewarnt oder nicht könnten Sie tryCatch verwenden. Wenn dies nicht das ist, was Sie wollen, oder Sie auf eine weitere testthat Ansatz, fühlen Sie sich frei zu sagen, "Sie sind Weg der Marke", sondern fügen Sie ein Emoticon wie :-) und es wird alles besser machen.

Zuerst mache ich eine temperamental Funktion, um nachzuahmen, was Sie beschreiben. Dann mache ich eine is.bad Funktion und suche nur nach Fehlern oder Warnungen (mach dir keine Sorgen über OS, da dieses Verhalten schwer vorherzusagen ist). Dann wickeln ich mit expect_true oder 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

Ich hatte das gleiche Problem und nach der Quelle zu lesen für beiden Funktionen ich eine gute Lösung gefunden. Eigentlich ist es sehr einfach, Sie müssen nur eine kleine if-Anweisung im Code von expect_error hinzufügen.

Dies ist der Code von 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) 
} 

eine if-Anweisung vor dem Rückgabewert wurde Sie überprüfen, ob ein Fehler Hinzufügen nicht für Warnungen geworfen und überprüfen (nicht vergessen, das alle Argument für die neue Funktion hinzufügen). Der neue Funktionscode ist dies:

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

Dieser Code ist sehr robust und leicht zu pflegen.Wenn Sie ein Paket schreiben und keine Funktionen verwenden können, die nicht exportiert werden (:: :), können Sie den Code aus make_label in die Funktion bringen, ist nur eine Zeile.