Fix uninformative collection errors for non-mirai errorValues (#643)

* Fix uninformative collection errors for non-mirai errorValues

* Cover Interrupted and errorCondition branches of stop_m

* Make cli branch test tolerant of missing rlang

Author: shikokuchuo

NEWS.md

@@ -2,6 +2,7 @@
 
 #### Updates
 
+* Fixes uninformative errors from `mirai_map()` collection when a task resolves to a non-mirai 'errorValue', e.g. cancelled or timed out (#642).
 * Removes an ineffective promise cache from the `as.promise()` method for 'mirai_map' objects.
 * Fixes `mirai_map()` collection option `.flat` ignoring an 'errorValue' in the first element (#639).
 * Fixes `daemon()` returning exit code 1 (idletime) instead of 2 (walltime) when `walltime` elapses while idle (#637).

R/map.R

@@ -311,13 +311,24 @@ mmap <- function(x, dots, envir = parent.frame()) {
 
 stop_m <- function(x, i, xi) {
   stop_mirai(x)
-  cli_enabled || stop(sprintf("In index %d:\n%s", i, attr(xi, "message")), call. = FALSE)
+  msg <- if (is_mirai_error(xi)) {
+    attr(xi, "message")
+  } else if (is_mirai_interrupt(xi)) {
+    "Interrupted"
+  } else {
+    nng_error(xi)
+  }
+  cli_enabled || stop(sprintf("In index %d:\n%s", i, msg), call. = FALSE)
   name <- names(x)[i]
   cli::cli_abort(
     c(i = "In index: {i}.", i = if (length(name) && nzchar(name)) "With name: {name}."),
     location = i,
     name = name,
-    parent = `class<-`(attributes(xi), c("error", "condition")),
+    parent = if (is_mirai_error(xi)) {
+      `class<-`(attributes(xi), c("error", "condition"))
+    } else {
+      errorCondition(msg)
+    },
     call = quote(mirai_map())
   )
 }

tests/tests.R

@@ -596,6 +596,20 @@ connection && NOT_CRAN && {
     tryCatch(m[.stop], error = identity)
   }
   test_equal(info()[["connections"]], 1L)
+  ns <- getNamespace("mirai")
+  original_cli <- mock_binding(ns, "cli_enabled", FALSE)
+  mp <- mirai_map(30, Sys.sleep)
+  stop_mirai(mp)
+  test_error(mp[.stop], "In index")
+  mp <- mirai_map(0L, function(x) signalCondition(structure(class = c("interrupt", "condition"), list())))
+  test_error(mp[.stop], "Interrupted")
+  restore_binding(ns, "cli_enabled", original_cli)
+  if (original_cli) {
+    mp <- mirai_map(30, Sys.sleep)
+    stop_mirai(mp)
+    err <- tryCatch(mp[.stop], error = identity)
+    test_true(is.null(err$parent) || is.character(conditionMessage(err$parent)))
+  }
   everywhere({ assign("lk", 0L, envir = globalenv()); lockBinding("lk", globalenv()) })
   e <- mirai(0L, lk = 1L, .timeout = 1000)[]
   if (is_mirai_error(e)) test_null(e$stack.trace) else test_equal(e, 5L)