BUG FIX: globalsByName(), and therefore also globalsOf(), did not sup…

…port special arguments '..1', ..2', etc. [#88]

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: globals
-Version: 0.16.2-9004
+Version: 0.16.2-9005
 Depends:
     R (>= 3.1.2)
 Imports:

NEWS.md

@@ -1,6 +1,9 @@
 # Version (development version)
 
- * ...
+## Bug Fixes
+
+ * `globalsByName()`, and therefore also `globalsOf()`, did not
+   support special arguments `..1`, `..2`, etc.
 
 
 # Version 0.16.2 [2022-11-21]

R/globalsByName.R

@@ -78,20 +78,26 @@ globalsByName <- function(names, envir = parent.frame(), mustExist = TRUE,
   }
 
   if (length(dotdotdots) > 0L) {
+    where... <- NULL
+    has... <- exists("...", envir = envir, inherits = TRUE)
+    if (has...) {
+        where... <- where("...", envir = envir, inherits = TRUE)
+    }
+
     for (name in dotdotdots) {
-      where[name] <- list(NULL)
-      ddd <- NA
-      if (name == "...") {
-        if (exists("...", envir = envir, inherits = TRUE)) {
-          where[["..."]] <- where("...", envir = envir, inherits = TRUE)
-          ## FIXME: If '...' in environment 'envir' specifies
-          ## non-existing symbols, then we must not call list(...), because
-          ## that will produce an "object not found" error.
-          ## /HB 2023-05-19
-          expr <- substitute(list(arg), list(arg = as.name("...")))
-          ddd <- eval(expr, envir = envir, enclos = envir)
-        }
+      where[name] <- list(where...)
+
+      ## FIXME: If '...' in environment 'envir' specifies non-existing
+      ## symbols, then we must not call list(...), list(..1), etc.,
+      ## because that will produce an "object not found" error.
+      ## /HB 2023-05-19
+      if (has...) {
+        expr <- substitute(list(arg), list(arg = as.name(name)))
+        ddd <- eval(expr, envir = envir, enclos = envir)
+      } else {
+        ddd <- NA
       }
+
       class(ddd) <- c("DotDotDotList", class(ddd))
       globals[[name]] <- ddd
     }

incl/globalsByName.R

@@ -27,7 +27,7 @@ h <- function(x = 42, ...) {
   globalsByName("..2")
 }
 
-globals <- h()
+globals <- h(x = 3.14, a = 1, b = 2)
 str(globals)
 
 globals <- g(3.14)

tests/dotdotdot.R

@@ -4,8 +4,8 @@ options(warn = 2L)
 
 exprs <- list(
   ok1   = quote(function(...) sum(x, ...)),
-  warn1 = quote(sum(x, ...)),
   ok2   = quote(function(...) sum(x, ..1, ..2, ..3)),
+  warn1 = quote(sum(x, ...)),
   warn2 = quote(sum(x, ..1, ..2, ..3))
 )
 
@@ -18,11 +18,11 @@ truth <- list(
 
 message("*** findGlobals() ...")
 
-
 for (name in names(exprs)) {
   expr <- exprs[[name]]
 
-  message("\n*** codetools::findGlobals():")
+  message(sprintf("\n*** codetools::findGlobals() - step %s:", sQuote(name)))
+  print(expr)
   fun <- globals:::as_function(expr)
   print(fun)
   ## Suppress '... may be used in an incorrect context' warnings
@@ -31,7 +31,8 @@ for (name in names(exprs)) {
   })
   print(globals)
   assert_identical_sets(globals, c("sum", "x"))
-
+  next
+
   message("\n*** findGlobals(dotdotdot = 'ignore'):")
   cat(sprintf("Expression '%s':\n", name))
   print(expr)  
@@ -64,6 +65,7 @@ for (name in names(exprs)) {
   }
 } # for (name ...)
 
+
 message("\n*** findGlobals(<exprs>, dotdotdot = 'return'):")
 print(exprs)
 globals <- findGlobals(exprs, dotdotdot = "return")
@@ -206,7 +208,7 @@ print(globals)
 
 } # aux()
 
-aux(x = 3:4, y = 1, z = 42L, exprs = exprs)
+aux(x = 3:4, y = 1, z = 42L, 3.14, exprs = exprs)
 message("*** function(x, ...) globalsOf() ... DONE")
 
 

tests/globalsByName.R

@@ -46,6 +46,17 @@ str(globals)
 assert_identical_sets(names(globals), c("a", "x", "..."))
 assert_identical_sets(names(globals[["..."]]), c("y", "z"))
 
+## And '..1', '..2', etc.
+myGlobals <- function(x, ...) {
+  globalsByName(c("a", "x", "..1", "..2"))
+}
+globals <- myGlobals(x = 2, y = 3, 4)
+str(globals)
+assert_identical_sets(names(globals), c("a", "x", "..1", "..2"))
+stopifnot(
+  globals[["..1"]] == 3,
+  globals[["..2"]] == 4
+)
 
 ## BUG FIX: Assert that '...' does not have to be specified at the end
 myGlobals <- function(x, ...) {