tests/globals,tricky.R

In future: Unified Parallel and Distributed Processing in R for Everyone

source("incl/start.R")
library("listenv")
oopts <- c(oopts, options(
  future.globals.resolve = TRUE,
  future.globals.onMissing = "error"
))

message("*** Tricky use cases related to globals ...")

for (cores in 1:availCores) {
  ## Speed up CRAN checks: Skip on CRAN Windows 32-bit
  if (!fullTest && isWin32) next
  
  message(sprintf("Testing with %d cores ...", cores))
  options(mc.cores = cores)

  message("availableCores(): ", availableCores())

  message("- Local variables with the same name as globals ...")

  for (strategy in supportedStrategies(cores)) {
    message(sprintf("- plan('%s') ...", strategy))
    plan(strategy)

    methods <- c("conservative", "ordered")
    for (method in methods) {
      options(future.globals.method = method)
      message(sprintf("Method for identifying globals: '%s' ...", method))

      a <- 3

      yTruth <- local({
        b <- a
        a <- 2
        a * b
      })

      y %<-% {
        b <- a
        a <- 2
        a * b
      }

      rm(list = "a")

      res <- try(y, silent = TRUE)
      if (method == "conservative" && strategy %in% c("multisession", "cluster")) {
        str(list(res = res))
        stopifnot(inherits(res, "try-error"))
      } else {
        message(sprintf("y = %g", y))
        stopifnot(identical(y, yTruth))
      }


      ## Same with forced lazy evaluation
      a <- 3

      y %<-% {
        b <- a
        a <- 2
        a * b
      } %lazy% TRUE

      rm(list = "a")

      res <- try(y, silent = TRUE)
      if (method == "conservative") {
        str(list(res = res))
        stopifnot(inherits(res, "try-error"))
      } else {
        message(sprintf("y = %g", y))
        stopifnot(identical(y, yTruth))
      }


      res <- listenv()
      a <- 1
      for (ii in 1:3) {
        res[[ii]] %<-% {
          b <- a * ii
          a <- 0
          b
        }
      }
      rm(list = "a")

      res <- try(unlist(res), silent = TRUE)
      if (method == "conservative" && strategy %in% c("multisession", "cluster")) {
        str(list(res = res))
        stopifnot(inherits(res, "try-error"))
      } else {
        print(res)
        stopifnot(all(res == 1:3))
      }


      ## Same with forced lazy evaluation
      res <- listenv()
      a <- 1
      for (ii in 1:3) {
        res[[ii]] %<-% {
          b <- a * ii
          a <- 0
          b
        } %lazy% TRUE
      }
      rm(list = "a")

      res <- try(unlist(res), silent = TRUE)
      if (method == "conservative") {
        str(list(res = res))
        stopifnot(inherits(res, "try-error"))
      } else {
        print(res)
        stopifnot(all(res == 1:3))
      }


      ## Assert that `a` is resolved and turned into a constant future
      ## at the moment when future `b` is created.
      ## Requires options(future.globals.resolve = TRUE).
      a <- future(1)
      b <- future(value(a) + 1)
      rm(list = "a")
      message(sprintf("value(b) = %g", value(b)))
      stopifnot(value(b) == 2)

      a <- future(1)
      b <- future(value(a) + 1, lazy = TRUE)
      rm(list = "a")
      message(sprintf("value(b) = %g", value(b)))
      stopifnot(value(b) == 2)

      a <- future(1, lazy = TRUE)
      b <- future(value(a) + 1)
      rm(list = "a")
      message(sprintf("value(b) = %g", value(b)))
      stopifnot(value(b) == 2)

      a <- future(1, lazy = TRUE)
      b <- future(value(a) + 1, lazy = TRUE)
      rm(list = "a")
      message(sprintf("value(b) = %g", value(b)))
      stopifnot(value(b) == 2)


      ## BUG FIX: In future (<= 1.0.0) a global 'pkg' would be
      ## overwritten by the name of the last package attached
      ## by the future.
      pkg <- "foo"
      f <- sequential({ pkg })
      v <- value(f)
      message(sprintf("value(f) = %s", sQuote(v)))
      stopifnot(pkg == "foo", v == "foo")
      
      message(sprintf("Method for identifying globals: '%s' ... DONE", method))
    }

    ## BUG FIX: In globals (<= 0.10.3) a global 'x' in LHS of an assignment
    ## would be missed.
    options(future.globals.method = "ordered")

    ## A local
    x <- 1
    f <- future({ x <- 0; x <- x + 1; x })
    v <- value(f)
    message(sprintf("value(f) = %s", sQuote(v)))
    stopifnot(v == 1)
    
    ## A global
    x <- 1
    f <- future({ x <- x + 1; x })
    v <- value(f)
    message(sprintf("value(f) = %s", sQuote(v)))
    stopifnot(v == 2)

    ## A global
    x <- function() TRUE
    f <- future({ x <- x(); x })
    v <- value(f)
    message(sprintf("value(f) = %s", sQuote(v)))
    stopifnot(v == TRUE)
  } ## for (strategy ...)

  message(sprintf("Testing with %d cores ... DONE", cores))
} ## for (cores ...)

message("*** Tricky use cases related to globals ... DONE")

source("incl/end.R")