Internal sQuoteLabel() now outputs <unnamed-N> for futures without label set + it accepts a Future object

Author: HenrikBengtsson

R/backend_api-11.ClusterFutureBackend-class.R

@@ -600,7 +600,7 @@ resolved.ClusterFuture <- function(x, run = TRUE, timeout = NULL, ...) {
   ## also the one that evaluates/resolves/queries it.
   assertOwner(future)
 
-  if (debug) mdebugf_push("resolved() for %s (%s) ...", class(future)[1], sQuoteLabel(future[["label"]]))
+  if (debug) mdebugf_push("resolved() for %s (%s) ...", class(future)[1], sQuoteLabel(future))
 
   node_idx <- future[["node"]]
   cl <- workers[node_idx]
@@ -947,7 +947,7 @@ receiveMessageFromWorker <- local({
       if (inherits(condition, "error")) {
         future[["result"]] <- msg
         future[["state"]] <- "failed"
-        label <- sQuoteLabel(future[["label"]])
+        label <- sQuoteLabel(future)
         stop(FutureError(sprintf("Received a %s condition from the %s worker for future (%s), which is not possible to relay because that would break the internal state of the future-worker communication. The condition message was: %s", class(condition)[1], class(future)[1], label, sQuote(conditionMessage(condition))), future = future))
       }
 
@@ -1165,7 +1165,7 @@ requestNode <- function(await, backend, timeout, delta, alpha) {
   for (kk in seq_along(futures)) {
     future <- futures[[kk]]
     if (node_idx == future[["node"]]) {
-      stop(FutureError(sprintf("[INTERNAL ERROR]: requestNode() found node #%d to be free, but it is used by future #%d (%s)", node_idx, kk, sQuoteLabel(future[["label"]]))))
+      stop(FutureError(sprintf("[INTERNAL ERROR]: requestNode() found node #%d to be free, but it is used by future #%d (%s)", node_idx, kk, sQuoteLabel(future))))
     }
   }
 
@@ -1260,7 +1260,7 @@ post_mortem_cluster_failure <- local({
     stop_if_not(length(node_info) == 1L)
 
     ## (3) Information on the future
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
 
     ## (4) POST-MORTEM ANALYSIS:
     postmortem <- list()
@@ -1450,7 +1450,7 @@ handleInterruptedFuture <- local({
     state <- future[["state"]]
     stop_if_not(state %in% c("canceled", "interrupted", "running"))
 
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     workers <- backend[["workers"]]
     node_idx <- future[["node"]]
     cl <- workers[node_idx]

R/backend_api-11.MulticoreFutureBackend-class.R

@@ -413,7 +413,7 @@ result.MulticoreFuture <- local({
       ## turn into an error with a more informative error message, cf.
       ## https://github.com/futureverse/future/issues/35
       if (is.null(result) || identical(result, structure("fatal error in wrapper code", class = "try-error"))) {
-        label <- sQuoteLabel(future[["label"]])
+        label <- sQuoteLabel(future)
 
         if (future[["state"]] %in% c("canceled", "interrupted")) {
           if (debug) mdebugf("Detected interrupted %s whose result cannot be retrieved", sQuote(class(future)[1]))

R/backend_api-Future-class.R

@@ -246,6 +246,21 @@ Future <- function(expr = NULL, envir = parent.frame(), substitute = TRUE, stdou
 
 
 sQuoteLabel <- function(label) {
+  if (inherits(label, "Future")) {
+    future <- label
+    label <- future[["label"]]
+    if (is.null(label)) {
+      uuid <- future[["uuid"]]
+      idx <- uuid[length(uuid)]
+      label <- sprintf("<unnamed-%s>", idx)
+    } else if (is.na(label)) {
+      label <- "NA"
+    } else {
+      label <- sQuote(label)
+    }
+    return(label)
+  }
+  
   if (is.null(label)) {
     "NULL"
   } else if (is.na(label)) {
@@ -261,7 +276,7 @@ print.Future <- function(x, ...) {
   future <- x
   class <- class(future)
   cat(sprintf("%s:\n", class[1]))
-  label <- sQuoteLabel(future[["label"]])
+  label <- sQuoteLabel(future)
   cat("Label: ", label, "\n", sep = "")
   cat("Expression:\n")
   print(future[["expr"]])
@@ -404,13 +419,13 @@ assertOwner <- local({
 run.Future <- function(future, ...) {
   debug <- isTRUE(getOption("future.debug"))
   if (debug) {
-    mdebugf_push("run() for %s (%s) ...", sQuote(class(future)[1]), sQuoteLabel(future[["label"]]))
+    mdebugf_push("run() for %s (%s) ...", sQuote(class(future)[1]), sQuoteLabel(future))
     mdebug("state: ", sQuote(future[["state"]]))
     on.exit(mdebugf_pop())
   }
 
   if (future[["state"]] != "created") {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     msg <- sprintf("A future (%s) can only be launched once", label)
     stop(FutureError(msg, future = future))
   }
@@ -459,7 +474,7 @@ run.Future <- function(future, ...) {
     }, error = function(ex) {
       ## Unexpected error
       msg <- conditionMessage(ex)
-      label <- sQuoteLabel(future[["label"]])
+      label <- sQuoteLabel(future)
       msg <- sprintf("Caught an unexpected error of class %s when trying to launch future (%s) on backend of class %s. The reason was: %s", class(ex)[1], label, class(backend)[1], msg)
       stop(FutureLaunchError(msg, future = future))
     })
@@ -599,7 +614,7 @@ result <- function(future, ...) {
       ## Signal FutureJournalCondition?
       if (!isTRUE(future[[".journal_signalled"]])) {
         journal <- journal(future)
-        label <- sQuoteLabel(future[["label"]])
+        label <- sQuoteLabel(future)
         msg <- sprintf("A future (%s) of class %s was resolved", label, class(future)[1])
         cond <- FutureJournalCondition(message = msg, journal = journal) 
         signalCondition(cond)
@@ -628,7 +643,7 @@ result <- function(future, ...) {
 result.Future <- function(future, ...) {
   debug <- isTRUE(getOption("future.debug"))
   if (debug) {
-    mdebugf_push("result() for %s (%s) ...", sQuote(class(future)[1]), sQuoteLabel(future[["label"]]))
+    mdebugf_push("result() for %s (%s) ...", sQuote(class(future)[1]), sQuoteLabel(future))
     mdebug("state: ", sQuote(future[["state"]]))
     on.exit(mdebugf_pop())
   }
@@ -686,7 +701,7 @@ result.Future <- function(future, ...) {
   ## Sanity check
   if (is.null(result) && version == "1.8") {
     if (inherits(future, "MulticoreFuture")) {
-      label <- sQuoteLabel(future[["label"]])
+      label <- sQuoteLabel(future)
       msg <- sprintf("A future (%s) of class %s did not produce a FutureResult object but NULL. This suggests that the R worker terminated (crashed?) before the future expression was resolved.", label, class(future)[1])
       stop(FutureError(msg, future = future))
     }
@@ -701,7 +716,7 @@ resolved.Future <- function(x, run = TRUE, ...) {
   future <- x
   debug <- isTRUE(getOption("future.debug"))
   if (debug) {
-    mdebugf_push("resolved() for %s (%s) ...", class(future)[1], sQuoteLabel(future[["label"]]))
+    mdebugf_push("resolved() for %s (%s) ...", class(future)[1], sQuoteLabel(future))
     on.exit(mdebug_pop())
     mdebug("state: ", sQuote(future[["state"]]))
     mdebug("run: ", run)

R/backend_api-UniprocessFuture-class.R

@@ -24,7 +24,7 @@ run.UniprocessFuture <- function(future, ...) {
   debug <- isTRUE(getOption("future.debug"))
 
   if (future[["state"]] != 'created') {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     stop(FutureError(sprintf("A future (%s) can only be launched once", label), future = future))
   }
 

R/core_api-value.R

@@ -54,7 +54,7 @@ value <- function(...) UseMethod("value")
 
 drop_future <- function(future) {
   class <- class(future)[1]
-  label <- sQuoteLabel(future[["label"]])
+  label <- sQuoteLabel(future)
   msg <- sprintf("Future (%s) of class %s is no longer valid, because its content has been minimized using value(..., drop = TRUE)", label, class)
   error <- FutureDroppedError(msg, future = future)
 
@@ -76,7 +76,7 @@ drop_future <- function(future) {
 value.Future <- function(future, stdout = TRUE, signal = TRUE, drop = FALSE, ...) {
   debug <- isTRUE(getOption("future.debug"))
   if (debug) {
-    mdebugf_push("value() for %s (%s) ...", class(future)[1], sQuoteLabel(future[["label"]]))
+    mdebugf_push("value() for %s (%s) ...", class(future)[1], sQuoteLabel(future))
     on.exit(mdebugf_pop())
   }
 

R/protected_api-FutureCondition-class.R

@@ -127,7 +127,7 @@ FutureError <- function(message, call = NULL, uuid = future[["uuid"]], future =
 #' @export
 RngFutureCondition <- function(message = NULL, call = NULL, uuid = future[["uuid"]], future = NULL) {
   if (is.null(message)) {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     message <- sprintf("UNRELIABLE VALUE: Future (%s) unexpectedly generated random numbers without specifying argument 'seed'. There is a risk that those random numbers are not statistically sound and the overall results might be invalid. To fix this, specify 'seed=TRUE'. This ensures that proper, parallel-safe random numbers are produced. To disable this check, use 'seed=NULL', or set option 'future.rng.onMisuse' to \"ignore\".", label)
   }
   cond <- FutureCondition(message = message, call = call, uuid = uuid, future = future)
@@ -160,7 +160,7 @@ RngFutureError <- function(...) {
 #' @rdname FutureCondition
 #' @export
 UnexpectedFutureResultError <- function(future, hint = NULL) {
-  label <- sQuoteLabel(future[["label"]])
+  label <- sQuoteLabel(future)
   expr <- hexpr(future[["expr"]])
   result <- future[["result"]]
   result_string <- hpaste(as.character(result))
@@ -192,7 +192,7 @@ UnexpectedFutureResultError <- function(future, hint = NULL) {
 #' @export
 GlobalEnvMisuseFutureCondition <- function(message = NULL, call = NULL, differences = NULL, uuid = future[["uuid"]], future = NULL) {
   if (is.null(message)) {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     message <- sprintf("%s (%s) added variables to the global environment. A future expression should never assign variables to the global environment - neither by assign() nor by <<-: [n=%d] %s", class(future)[1], label, length(differences[["added"]]), commaq(differences[["added"]]))
     message <- sprintf("%s. See also help(\"future.options\", package = \"future\")", message)
   }
@@ -226,7 +226,7 @@ GlobalEnvMisuseFutureError <- function(...) {
 #' @export
 ConnectionMisuseFutureCondition <- function(message = NULL, call = NULL, differences = NULL, uuid = future[["uuid"]], future = NULL) {
   if (is.null(message)) {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     message <- sprintf("%s (%s) added, removed, or modified connections. A future expression must close any opened connections and must not close connections it did not open", class(future)[1], label)
     if (!is.null(differences)) {
       details <- lapply(differences, FUN = function(diffs) {
@@ -278,7 +278,7 @@ ConnectionMisuseFutureError <- function(...) {
 #' @export
 DeviceMisuseFutureCondition <- function(message = NULL, call = NULL, differences = NULL, uuid = future[["uuid"]], future = NULL) {
   if (is.null(message)) {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     message <- sprintf("%s (%s) added, removed, or modified devices. A future expression must close any opened devices and must not close devices it did not open", class(future)[1], label)
     if (!is.null(differences)) {
       details <- character(0L)
@@ -323,7 +323,7 @@ DeviceMisuseFutureError <- function(...) {
 #' @export
 DefaultDeviceMisuseFutureCondition <- function(message = NULL, incidents = NULL, call = NULL, uuid = future[["uuid"]], future = NULL) {
   if (is.null(message)) {
-    label <- sQuoteLabel(future[["label"]])
+    label <- sQuoteLabel(future)
     message <- sprintf("%s (%s) opened the default graphics device", class(future)[1], label)
     if (length(incidents) > 0L) {
       calls <- lapply(incidents, FUN = lapply, deparse)

R/protected_api-FutureResult-class.R

@@ -145,7 +145,7 @@ assertFutureResult <- function(future, debug = FALSE) {
     if (debug) mdebug("identical; success")
     return(NULL)
   }
-  label <- sQuoteLabel(future[["label"]])
+  label <- sQuoteLabel(future)
   result_uuid <- paste(uuid, collapse = "-")
   future_uuid <- paste(future[["uuid"]], collapse = "-")
   msg <- sprintf("Result for future (%s) is from another future. UUIDs do not match: %s != %s", label, result_uuid, future_uuid)

R/protected_api-signalConditions.R

@@ -95,7 +95,7 @@ signalConditions <- function(future, include = "condition", exclude = NULL, resi
       stop(condition)
     } else if (inherits(condition, "interrupt")) {
       future[["state"]] <- "interrupted"
-      label <- sQuoteLabel(future[["label"]])
+      label <- sQuoteLabel(future)
       result <- future[["result"]]
       when <- result[["finished"]]
       session_uuid <- result[["session_uuid"]]

R/utils-connections.R

@@ -12,7 +12,7 @@ check_connection_details <- function(worker, future) {
   isValid <- isConnectionValid(con)
   if (isValid) return(NULL)
 
-  label <- sQuoteLabel(future[["label"]])
+  label <- sQuoteLabel(future)
 
   reason <- attr(isValid, "reason", exact = TRUE)
   reason <- gsub("[.]?[[:space:]]*$", "", reason)