TESTS: Assert that all backends record 'immediateCondition' as expected

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future
-Version: 1.49.0-9023
+Version: 1.49.0-9024
 Title: Unified Parallel and Distributed Processing in R for Everyone
 Depends:
     R (>= 3.2.0)

R/backend_api-11.SequentialFutureBackend-class.R

@@ -102,6 +102,8 @@ nbrOfWorkers.SequentialFutureBackend <- function(evaluator) {
 
 
 #' @export
+
+
 nbrOfFreeWorkers.SequentialFutureBackend <- function(evaluator, background = FALSE, ...) {
   assert_no_positional_args_but_first()
   if (isTRUE(background)) 0L else 1L
@@ -117,9 +119,13 @@ getFutureBackendConfigs.UniprocessFuture <- function(future, ...) {
     immediateConditionHandlers = list(
       immediateCondition = local({
         prev <- NULL
-        function(condition) {
-          ## Avoid re-catching itself
-          if (identical(condition, prev)) return(FALSE)
+        function(condition) {  
+          ## Avoid re-catching and re-signaling itself
+          if (identical(condition, prev)) {
+            prev <<- NULL
+            muffleCondition(condition)
+            return(FALSE)
+          }
           prev <<- condition
           ## Resignal condition
           if (inherits(condition, "warning")) {

inst/testme/test-immediateCondition.R

@@ -90,7 +90,7 @@ for (ss in seq_along(strategies)) {
       stopifnot(length(msgs) == 0L)
     }
   })
-  
+
   message("- checking if resolved")
   msgs <- recordMessages({
     r <- resolved(f)
@@ -140,7 +140,23 @@ for (ss in seq_along(strategies)) {
       stopifnot(identical(msgs, c("IM1\n", "IW", "IM2\n", "M\n")))
     }
   })
-  
+
+  r <- result(f)
+  conditions <- r$conditions
+  if (length(conditions) != 4L) {
+    str(conditions)
+    stopifnot(length(conditions) == 4L)
+  }
+  conditions <- lapply(conditions, FUN = .subset2, "condition")
+  str(conditions)
+  stopifnot(length(conditions) == 4L)
+  stopifnot(
+    vapply(conditions, FUN.VALUE = FALSE, FUN = inherits, "condition"),
+    vapply(conditions[c(1,3,4)], FUN.VALUE = FALSE, FUN = inherits, "immediateCondition"),
+    vapply(conditions[c(1,2,4)], FUN.VALUE = FALSE, FUN = inherits, "message"),
+    vapply(conditions[c(3)], FUN.VALUE = FALSE, FUN = inherits, "warning")
+  )
+
   message("- getting value again")
   msgs <- recordMessages({
     v <- value(f)
@@ -270,4 +286,3 @@ for (ss in seq_along(strategies)) {
 } ## for (ss ...)
 
 message("*** immediateCondition:s ... DONE")
-