Merge pull request #1424 from 0UmfHxcvx5J7JoaOhFSs5mncnisTJJ6q/dev/be…

…tter_test_errors better error messages for failed tests
remindmodel · Oct 5, 2023 · 87f5d85 · 87f5d85
2 parents 2e93f68 + 01abb2b
commit 87f5d85
Show file tree

Hide file tree

Showing 2 changed files with 55 additions and 10 deletions.
diff --git a/tests/testthat/helper_localSystem2.R b/tests/testthat/helper_localSystem2.R
@@ -21,5 +21,10 @@ localSystem2 <- function(command, args = character(),
     if (is.null(attr(output, 'status', exact = TRUE))) {
         attr(output, 'status') <- 0
     }
+
+    # include command and arguments in output for pretty errors
+    attr(output, 'command') <- command
+    attr(output, 'args') <- args
+
     return(output)
 }
diff --git a/tests/testthat/helper_skipFailed.R b/tests/testthat/helper_skipFailed.R
@@ -6,19 +6,59 @@
 # |  Contact: remind@pik-potsdam.de
 helperSkipFailed <- FALSE
 
-expectSuccessStatus <- function(output) {
-    status <- attr(output, "status", exact = TRUE)
-    if (0 != status) {
-        helperSkipFailed <<- TRUE
+expect_exit_status_n <- function(object, n = 0, invert = FALSE) {
+    act <- quasi_label(rlang::enquo(object), arg = 'object')
+
+    status <- attr(act[['val']], 'status', exact = TRUE)
+
+    if (all(c('command', 'args') %in% names(attributes(act[['val']])))) {
+        label <- paste0('`', attr(act[['val']], 'command', exact = TRUE), ' ',
+                        paste(attr(act[['val']], 'args', exact = TRUE),
+                              collapse = ' '),
+                        '`')
+    }
+    else {
+        label <- act[['lab']]
+    }
+
+    # empty trace to suppress testthat backtrace
+    empty_trace <- structure(
+        list(call      = list(),
+             parent    = integer(0),
+             visible   = logical(0),
+             namespace = character(0),
+             scope     = character(0)),
+        row.names = integer(0),
+        version   = 2L,
+        class     = c('rlang_trace', 'rlib_trace', 'tbl', 'data.frame'))
+
+    if (isFALSE(invert)) {
+        if (n != status)
+            helperSkipFailed <<- TRUE
+
+        expect(n == status,
+               sprintf('%s returned exit status %i, not %i', label, status, n),
+               trace = empty_trace)
     }
-    expect_equal(status, 0)
+    else {
+        if (n == status)
+            helperSkipFailed <<- TRUE
+
+        expect(n != status,
+               sprintf('%s returned exit status %i, which it should not',
+                       label, status),
+               trace = empty_trace)
+    }
+
+    invisible(act[['val']])
+}
+
+expectSuccessStatus <- function(output) {
+    expect_exit_status_n(output, 0, FALSE)
 }
+
 expectFailStatus <- function(output) {
-    status <- attr(output, "status", exact = TRUE)
-    if (1 != status) {
-        helperSkipFailed <<- TRUE
-    }
-    expect_equal(status, 1)
+    expect_exit_status_n(output, 0, TRUE)
 }
 
 skipIfPreviousFailed <- function() {