BUG FIX: as.Globals(list(a = NULL)) would include the calling environment instead of an empty environment as part of the 'where' attribute (fix #79)

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: globals
-Version: 0.14.0-9000
+Version: 0.14.0-9002
 Depends:
     R (>= 3.1.2)
 Imports:

NEWS

@@ -1,10 +1,14 @@
 Package: globals
 ================
 
-Version: 0.14.0-9000 [2020-11-22]
+Version: 0.14.0-9002 [2022-05-06]
 
- * ...
- 
+BUG FIXES:
+
+ * as.Globals(list(a = NULL)) and c(Globals(), list(a = NULL)) would
+   include the calling environment instead of an empty environment as
+   part of the 'where' attribute.
+   
 
 Version: 0.14.0 [2020-11-22]
 

R/Globals-class.R

@@ -58,11 +58,7 @@ as.Globals.list <- function(x, ...) {
   ## (with emptyenv() as the fallback)
   where <- attr(x, "where", exact = TRUE)
   if (is.null(where)) {
-    where <- lapply(x, FUN = function(obj) {
-        e <- environment(obj)
-        if (is.null(e)) e <- emptyenv()
-        e
-    })
+    where <- lapply(x, FUN = environment_of)
     names(where) <- names(x)
     attr(x, "where") <- where
   }
@@ -115,10 +111,8 @@ as.Globals.list <- function(x, ...) {
       x[[name]] <- value[[1]]
       where[[name]] <- attr(value, "where", exact = TRUE)[[1]]
     } else {
-      w <- environment(value)
-      if (is.null(w)) w <- emptyenv()
       x[[name]] <- value
-      where[[name]] <- w
+      where[[name]] <- environment_of(value)
     }
   }
 
@@ -148,19 +142,14 @@ c.Globals <- function(x, ...) {
 
       names <- names(g)
       stop_if_not(!is.null(names))
-      w <- lapply(g, FUN = function(obj) {
-        e <- environment(obj)
-        if (is.null(e)) e <- emptyenv()
-        e
-      })
+      w <- lapply(g, FUN = environment_of)
       names(w) <- names
     } else {
       if (is.null(name)) {
         stopf("Can only append named objects to Globals list: %s", sQuote(mode(g)))
       }
       g <- structure(list(g), names = name)
-      e <- environment(g)
-      if (is.null(e)) e <- emptyenv()
+      e <- environment_of(g)
       w <- structure(list(e), names = name)
     }
     where <- c(where, w)

R/environment_of.R

@@ -0,0 +1,9 @@
+# A safe version of base::environment() that returns emptyenv()
+# if NULL is passed, instead of the calling environment.
+# Related to https://github.com/HenrikBengtsson/globals/issues/79
+environment_of <- function(obj) {
+  if (is.null(obj)) return(emptyenv())
+  e <- environment(obj)
+  if (is.null(e)) return(emptyenv())
+  e
+}

R/packagesOf.R

@@ -14,7 +14,7 @@ packagesOf.Globals <- function(globals, ...) {
   ## Scan 'globals' for which packages needs to be loaded.
   ## This information is in the environment name of the objects.
   pkgs <- vapply(globals, FUN = function(obj) {
-    environmentName(environment(obj))
+    environmentName(environment_of(obj))
   }, FUN.VALUE = "", USE.NAMES = FALSE)
 
   ## Drop "missing" packages, e.g. globals in globalenv().

tests/Globals.R

@@ -246,6 +246,36 @@ globals <- as.Globals(list())
 message("*** Globals() - empty ... DONE")
 
 
+message("*** Globals() - NULL ...")
+## https://github.com/HenrikBengtsson/globals/issues/79
+
+globals <- as.Globals(list(a = NULL))
+str(globals)
+where <- attr(globals, "where")
+stopifnot(
+  length(globals) == 1L,
+  length(where) == length(globals),
+  all(names(where) == names(globals)),
+  identical(names(globals), c("a")),
+  is.null(globals[["a"]]),
+  identical(where[["a"]], emptyenv())
+)
+
+globals <- c(Globals(), list(a = NULL))
+str(globals)
+where <- attr(globals, "where")
+stopifnot(
+  length(globals) == 1L,
+  length(where) == length(globals),
+  all(names(where) == names(globals)),
+  identical(names(globals), c("a")),
+  is.null(globals[["a"]]),
+  identical(where[["a"]], emptyenv())
+)
+
+message("*** Globals() - NULL ... DONE")
+
+
 message("*** Globals() - exceptions ...")
 
 res <- tryCatch({ Globals(NULL) }, error = identity)