Polish parallel errors

Author: hadley

R/parallel-taskq.R

@@ -206,7 +206,7 @@ task_q <- R6::R6Class(
     },
 
     handle_error = function(msg, task_no) {
-      cli::cli_inform("") # get out of the progress bar, if any
+      cat("\n") # get out of the progress bar, if any
       fun <- private$tasks$fun[[task_no]]
       file <- private$tasks$args[[task_no]][[1]]
       if (is.null(fun)) {
@@ -218,18 +218,19 @@ task_q <- R6::R6Class(
         cli::cli_abort(
           c(
             "testthat subprocess failed to start.",
-            "i" = "stderr: {msg$error$stderr}"
+            " " = "{no_wrap(msg$error$stderr)}"
           ),
           test_file = NULL,
-          parent = msg$error,
-          class = c("testthat_process_error", "testthat_error")
+          class = c("testthat_process_error", "testthat_error"),
+          call = NULL
         )
       } else {
         cli::cli_abort(
           "testthat subprocess exited in file {.file {file}}.",
           test_file = file,
           parent = msg$error,
-          class = c("testthat_process_error", "testthat_error")
+          class = c("testthat_process_error", "testthat_error"),
+          call = NULL
         )
       }
     }

R/snapshot-value.R

@@ -116,14 +116,10 @@ check_roundtrip <- function(
     tolerance = tolerance
   )
   if (length(check) > 0) {
-    # Supress cli wrapping
-    check <- gsub(" ", "\u00a0", check, fixed = TRUE)
-    check <- gsub("\n", "\f", check, fixed = TRUE)
-
     cli::cli_abort(
       c(
         "{.code {label}} could not be safely serialized with {.arg style} = {.str {style}}.",
-        " " = "Serializing then deserializing the object returned something new:\n\n{check}\n",
+        " " = "Serializing then deserializing the object returned something new:\n\n{no_wrap(check)}\n",
         i = "You may need to try a different {.arg style}."
       ),
       call = error_call

R/source.R

@@ -64,7 +64,7 @@ source_file <- function(
       invisible(eval(exprs, env)),
       error = function(err) {
         cli::cli_abort(
-          "In path: {.path {path}}.",
+          "Failed to evaluate {.path {path}}.",
           parent = err,
           call = error_call
         )
@@ -128,9 +128,17 @@ source_dir <- function(
   chdir = TRUE,
   wrap = TRUE
 ) {
-  files <- normalizePath(sort(dir(path, pattern, full.names = TRUE)))
+  files <- sort(dir(path, pattern, full.names = TRUE))
+
+  error_call <- current_env()
   lapply(files, function(path) {
-    source_file(path, env = env, chdir = chdir, wrap = wrap)
+    source_file(
+      path,
+      env = env,
+      chdir = chdir,
+      wrap = wrap,
+      error_call = error_call
+    )
   })
 }
 

R/utils.R

@@ -56,3 +56,10 @@ in_rcmd_check <- function() {
 }
 
 r_version <- function() paste0("R", getRversion()[, 1:2])
+
+# Supress cli wrapping
+no_wrap <- function(x) {
+  x <- gsub(" ", "\u00a0", x, fixed = TRUE)
+  x <- gsub("\n", "\f", x, fixed = TRUE)
+  x
+}

tests/testthat/_snaps/source.md

@@ -4,7 +4,7 @@
       source_file(test_path("reporters/error-setup.R"), wrap = FALSE)
     Condition
       Error:
-      ! In path: 'reporters/error-setup.R'.
+      ! Failed to evaluate 'reporters/error-setup.R'.
       Caused by error in `h()`:
       ! !
 

tests/testthat/test-parallel-setup.R

@@ -9,5 +9,5 @@ test_that("error in parallel setup code", {
     error = function(e) e
   )
   expect_s3_class(err, "testthat_process_error")
-  expect_match(err$message, "Error in setup", fixed = TRUE)
+  expect_match(conditionMessage(err), "Error in setup", fixed = TRUE)
 })

tests/testthat/test-parallel-startup.R

@@ -9,5 +9,5 @@ test_that("startup error", {
     error = function(e) e
   )
   expect_s3_class(err, "testthat_process_error")
-  expect_match(err$message, "This will fail", fixed = TRUE)
+  expect_match(conditionMessage(err), "This will fail", fixed = TRUE)
 })

tests/testthat/test-parallel/startup/R/fail.R

@@ -1,3 +1,3 @@
 .onLoad <- function(libname, pkgname) {
-  stop("This will fail when loading the package")
+  stop("This will fail when loading the package", call. = FALSE)
 }