R Under development (unstable) (2024-03-06 r86056 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> source("incl/start.R")
> 
> message("*** cleanup() ...")
*** cleanup() ...
> 
> message("- cleanup() with remapped base functions")
- cleanup() with remapped base functions
> 
> ## Don't clean out renamed base functions
> ## https://github.com/HenrikBengtsson/globals/issues/57
> globals <- list(
+   my_fcn      = function(x) x,   ## should not be deleted
+   identity    = base::identity,
+   my_identity = base::identity   ## should not be deleted
+ )
> expected <- c("my_fcn", "my_identity")
> 
> ## Add an example of an internal/non-exported package object from 'utils'.
> ## Such objects need to be kept because they will not be on the search path
> ## even if the package is attached
> ns <- asNamespace("utils")
> pkg <- as.environment("package:utils")
> internals <- setdiff(ls(ns, all.names = TRUE), ls(pkg, all.names = TRUE))
> internals <- grep("^print", internals, value = TRUE)
> if (length(internals) > 0L) {
+   name <- internals[1]
+   obj <- get(name, envir = ns, inherits = FALSE)
+   stopifnot(!exists(name, envir = pkg, inherits = FALSE))
+   globals[[name]] <- obj
+   expected <- c(expected, name)
+   name <- sprintf("my-%s", name)
+   globals[[name]] <- obj
+   expected <- c(expected, name)
+ }
> 
> globals <- as.Globals(globals)
> str(globals)
List of 5
 $ my_fcn         :function (x)  
 $ identity       :function (x)  
 $ my_identity    :function (x)  
 $ print.Bibtex   :function (x, prefix = "", ...)  
 $ my-print.Bibtex:function (x, prefix = "", ...)  
 - attr(*, "where")=List of 5
  ..$ my_fcn         :<environment: R_GlobalEnv> 
  ..$ identity       :<environment: namespace:base> 
  ..$ my_identity    :<environment: namespace:base> 
  ..$ print.Bibtex   :<environment: namespace:utils> 
  ..$ my-print.Bibtex:<environment: namespace:utils> 
 - attr(*, "class")= chr [1:2] "Globals" "list"
> 
> globals <- cleanup(globals)
> str(globals)
List of 4
 $ my_fcn         :function (x)  
 $ my_identity    :function (x)  
 $ print.Bibtex   :function (x, prefix = "", ...)  
 $ my-print.Bibtex:function (x, prefix = "", ...)  
 - attr(*, "where")=List of 4
  ..$ my_fcn         :<environment: R_GlobalEnv> 
  ..$ my_identity    :<environment: namespace:base> 
  ..$ print.Bibtex   :<environment: namespace:utils> 
  ..$ my-print.Bibtex:<environment: namespace:utils> 
 - attr(*, "class")= chr [1:2] "Globals" "list"
> assert_identical_sets(names(globals), expected)
> 
> 
> message("- cleanup() with missing globals")
- cleanup() with missing globals
> rm(list = "b")
> expr <- quote(a <- b)
> print(expr)
a <- b
> globals <- globalsOf(expr, mustExist = FALSE)
> str(globals)
List of 2
 $ <-:.Primitive("<-") 
 $ b : NULL
 - attr(*, "where")=List of 2
  ..$ <-:<environment: base> 
  ..$ b : NULL
 - attr(*, "class")= chr [1:2] "Globals" "list"
> stopifnot(identical(names(globals), c("<-", "b")))
> 
> 
> message("- cleanup(globals) with missing globals")
- cleanup(globals) with missing globals
> pruned <- cleanup(globals)
> str(pruned)
 Named list()
 - attr(*, "where")= Named list()
 - attr(*, "class")= chr [1:2] "Globals" "list"
> stopifnot(length(pruned) == 0L)
> 
> message("- cleanup(globals, drop = 'missing') with missing globals")
- cleanup(globals, drop = 'missing') with missing globals
> pruned <- cleanup(globals, drop = "missing")
> str(pruned)
List of 1
 $ <-:.Primitive("<-") 
 - attr(*, "where")=List of 1
  ..$ <-:<environment: base> 
 - attr(*, "class")= chr [1:2] "Globals" "list"
> stopifnot(identical(names(pruned), c("<-")))
> 
> message("- cleanup(globals, drop = 'base-packages') with missing globals")
- cleanup(globals, drop = 'base-packages') with missing globals
> pruned <- cleanup(globals, drop = "base-packages")
> str(pruned)
List of 1
 $ b: NULL
 - attr(*, "where")=List of 1
  ..$ b: NULL
 - attr(*, "class")= chr [1:2] "Globals" "list"
> stopifnot(identical(names(pruned), c("b")))
> 
> message("*** cleanup() ... DONE")
*** cleanup() ... DONE
> 
> source("incl/end.R")
> 
> proc.time()
   user  system elapsed 
   0.18    0.04    0.21