globals/0000755000176200001440000000000013573012452011677 5ustar liggesusersglobals/NAMESPACE0000644000176200001440000000121413573005670013120 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$<-",Globals) S3method("[",Globals) S3method("names<-",Globals) S3method(as.Globals,Globals) S3method(as.Globals,list) S3method(c,Globals) S3method(cleanup,Globals) S3method(packagesOf,Globals) S3method(unique,Globals) export(Globals) export(as.Globals) export(cleanup) export(findGlobals) export(globalsByName) export(globalsOf) export(packagesOf) export(walkAST) importFrom(codetools,findLocalsList) importFrom(codetools,makeUsageCollector) importFrom(codetools,walkCode) importFrom(utils,capture.output) importFrom(utils,getS3method) importFrom(utils,packageDescription) importFrom(utils,str) globals/man/0000755000176200001440000000000013557155442012463 5ustar liggesusersglobals/man/globalsByName.Rd0000644000176200001440000000127613557155312015473 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/globalsOf.R \name{globalsByName} \alias{globalsByName} \title{Locates and retrieves a set of global variables by their names} \usage{ globalsByName(names, envir = parent.frame(), mustExist = TRUE, ...) } \arguments{ \item{names}{A character vector of global variable names.} \item{envir}{The environment from where to search for globals.} \item{mustExist}{If TRUE, an error is thrown if the object of the identified global cannot be located. Otherwise, the global is not returned.} \item{...}{Not used.} } \value{ A \link{Globals} object. } \description{ Locates and retrieves a set of global variables by their names } globals/man/private_length.Rd0000644000176200001440000000103613557155312015761 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{.length} \alias{.length} \title{Gets the length of an object without dispatching} \usage{ .length(x) } \arguments{ \item{x}{Any \R object.} } \value{ A non-negative integer. } \description{ Gets the length of an object without dispatching } \details{ This function returns \code{length(unclass(x))}, but tries to avoid calling \code{unclass(x)} unless necessary. } \seealso{ \code{\link{.subset}()} and \code{\link{.subset2}()}. } \keyword{internal} globals/man/packagesOf.Globals.Rd0000644000176200001440000000067213557155312016400 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/packagesOf.R \name{packagesOf.Globals} \alias{packagesOf.Globals} \alias{packagesOf} \title{Identify the packages of the globals} \usage{ \method{packagesOf}{Globals}(globals, ...) } \arguments{ \item{globals}{A Globals object.} \item{\dots}{Not used.} } \value{ Returns a character vector of package names. } \description{ Identify the packages of the globals } globals/man/cleanup.Globals.Rd0000644000176200001440000000072513570617727015773 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/cleanup.R \name{cleanup.Globals} \alias{cleanup.Globals} \alias{cleanup} \title{Drop certain types of globals} \usage{ \method{cleanup}{Globals}(globals, drop = c("missing", "base-packages"), ...) } \arguments{ \item{globals}{A Globals object.} \item{drop}{A character vector specifying what type of globals to drop.} \item{\dots}{Not used} } \description{ Drop certain types of globals } globals/man/Globals.Rd0000644000176200001440000000111513557155312014327 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Globals-class.R \name{Globals} \alias{Globals} \alias{as.Globals} \alias{as.Globals.Globals} \alias{as.Globals.list} \alias{[.Globals} \alias{names} \title{A representation of a set of globals} \usage{ Globals(object, ...) } \arguments{ \item{object}{A named list.} \item{\dots}{Not used.} } \value{ An object of class \code{Future}. } \description{ A representation of a set of globals } \seealso{ The \code{\link{globalsOf}()} function identifies globals from an R expression and returns a Globals object. } globals/man/globalsOf.Rd0000644000176200001440000000623513570617727014674 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/findGlobals.R, R/globalsOf.R \name{findGlobals} \alias{findGlobals} \alias{globalsOf} \title{Get all global objects of an expression} \usage{ findGlobals( expr, envir = parent.frame(), ..., tweak = NULL, dotdotdot = c("warning", "error", "return", "ignore"), method = c("ordered", "conservative", "liberal"), substitute = FALSE, unlist = TRUE, trace = FALSE ) globalsOf( expr, envir = parent.frame(), ..., method = c("ordered", "conservative", "liberal"), tweak = NULL, substitute = FALSE, mustExist = TRUE, unlist = TRUE, recursive = TRUE, skip = NULL ) } \arguments{ \item{expr}{An R expression.} \item{envir}{The environment from where to search for globals.} \item{\dots}{Not used.} \item{tweak}{An optional function that takes an expression and returns a tweaked expression.} \item{dotdotdot}{TBD.} \item{method}{A character string specifying what type of search algorithm to use.} \item{substitute}{If TRUE, the expression is \code{substitute()}:ed, otherwise not.} \item{unlist}{If TRUE, a list of unique objects is returned. If FALSE, a list of \code{length(expr)} sublists.} \item{trace}{TBD.} \item{mustExist}{If TRUE, an error is thrown if the object of the identified global cannot be located. Otherwise, the global is not returned.} \item{recursive}{If TRUE, globals that are closures (functions) and that exist outside of namespaces ("packages"), will be recursively scanned for globals.} \item{skip}{(internal) A list of globals not to be searched for additional globals. Ignored unless \code{recursive} is TRUE.} } \value{ \code{findGlobals()} returns a character vector. \code{globalsOf()} returns a \link{Globals} object. } \description{ Get all global objects of an expression } \details{ There currently three strategies for identifying global objects. The \code{method = "ordered"} search method identifies globals such that a global variable preceding a local variable with the same name is not dropped (which the \code{"conservative"} method would). The \code{method = "conservative"} search method tries to keep the number of false positive to a minimum, i.e. the identified objects are most likely true global objects. At the same time, there is a risk that some true globals are not identified (see example). This search method returns the exact same result as the \code{\link[codetools]{findGlobals}()} function of the \pkg{codetools} package. The \code{method = "liberal"} search method tries to keep the true-positive ratio as high as possible, i.e. the true globals are most likely among the identified ones. At the same time, there is a risk that some false positives are also identified. With \code{recursive = TRUE}, globals part of locally defined functions will also be found, otherwise not. } \examples{ b <- 2 expr <- substitute({ a <- b; b <- 1 }) ## Will _not_ identify 'b' (because it's also a local) globalsC <- globalsOf(expr, method = "conservative") print(globalsC) ## Will identify 'b' globalsL <- globalsOf(expr, method = "liberal") print(globalsL) } \seealso{ Internally, the \pkg{\link{codetools}} package is utilized for code inspections. } globals/man/walkAST.Rd0000644000176200001440000000171113570617727014264 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/walkAST.R \name{walkAST} \alias{walkAST} \title{Walk the Abstract Syntax Tree (AST) of an R Expression} \usage{ walkAST( expr, atomic = NULL, name = NULL, call = NULL, pairlist = NULL, substitute = FALSE ) } \arguments{ \item{expr}{R \link[base]{expression}.} \item{atomic, name, call, pairlist}{single-argument function that takes an atomic, name, call and pairlist expression, respectively. Have to return a valid R expression.} \item{name}{single-argument function that takes a name expression.} \item{call}{single-argument function that takes a call expression.} \item{pairlist}{single-argument function that takes a pairlist expression.} \item{substitute}{If TRUE, \code{expr} is \code{\link[base]{substitute}()}:ed.} } \value{ R \link[base]{expression}. } \description{ Walk the Abstract Syntax Tree (AST) of an R Expression } \keyword{internal} \keyword{programming} globals/DESCRIPTION0000644000176200001440000000170013573012452013403 0ustar liggesusersPackage: globals Version: 0.12.5 Depends: R (>= 3.1.2) Imports: codetools Title: Identify Global Objects in R Expressions Authors@R: c( person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"), email="henrikb@braju.com")) Description: Identifies global ("unknown" or "free") objects in R expressions by code inspection using various strategies, e.g. conservative or liberal. The objective of this package is to make it as simple as possible to identify global objects for the purpose of exporting them in distributed compute environments. License: LGPL (>= 2.1) LazyLoad: TRUE ByteCompile: TRUE URL: https://github.com/HenrikBengtsson/globals BugReports: https://github.com/HenrikBengtsson/globals/issues RoxygenNote: 7.0.2 NeedsCompilation: no Packaged: 2019-12-07 20:32:40 UTC; hb Author: Henrik Bengtsson [aut, cre, cph] Maintainer: Henrik Bengtsson Repository: CRAN Date/Publication: 2019-12-07 21:10:02 UTC globals/tests/0000755000176200001440000000000013573006150013037 5ustar liggesusersglobals/tests/incl/0000755000176200001440000000000013557345251013776 5ustar liggesusersglobals/tests/incl/start,load-only.R0000644000176200001440000000154613557160317017155 0ustar liggesuserssource("incl/globals.R") ## Record original state ovars <- ls() oenvs <- oenvs0 <- Sys.getenv() oopts0 <- options() ## Default options for tests oopts <- options() ## Private global functions as_function <- globals:::as_function is_base_pkg <- globals:::is_base_pkg is.base <- globals:::is.base is_internal <- globals:::is_internal where <- globals:::where mdebug <- globals:::mdebug envname <- globals:::envname assert_identical_sets <- function(a, b) { a <- sort(a) b <- sort(b) if (!identical(a, b)) { stop(sprintf("Non-identical sets: %s != %s", paste(sQuote(a), collapse = ", "), paste(sQuote(b), collapse = ", "))) } } ## WORKAROUND: Make sure tests also work with 'covr' package covr <- ("covr" %in% loadedNamespaces()) if (covr) { globalenv <- function() parent.frame() baseenv <- function() environment(base::sample) } globals/tests/incl/start.R0000644000176200001440000000006413557155442015257 0ustar liggesuserslibrary("globals") source("incl/start,load-only.R") globals/tests/incl/globals.R0000644000176200001440000000076513557345251015554 0ustar liggesusers## Define some globals a <- 0 b <- 2 c <- 3 d <- NULL e <- function() TRUE ## Expression with globals exprs <- list( A = quote({ x <- b b <- 1 y <- c z <- d a <- a + 1 e <- e() }), B = substitute(a <- pkg::a, env=environment()), C = quote({ foo(list(a = 1)) }), D = quote({ x <- sample(10) y <- sum(x) x2 <- sample2(10) y2 <- sum2(x) s <- sessionInfo() }) ) globals/tests/incl/end.R0000644000176200001440000000217313557155442014673 0ustar liggesusers## Undo options ## (a) Added added <- setdiff(names(options()), names(oopts0)) opts <- vector("list", length = length(added)) names(opts) <- added options(opts) ## (b) Modified options(oopts) ## (c) Removed, e.g. future.plan=NULL removed <- setdiff(names(oopts0), names(options())) opts <- oopts0[removed] options(opts) ## (d) Assert that everything was undone stopifnot(identical(options(), oopts0)) ## Undo system environment variables ## (a) Added cenvs <- Sys.getenv() added <- setdiff(names(cenvs), names(oenvs0)) for (name in added) Sys.unsetenv(name) ## (b) Missing missing <- setdiff(names(oenvs0), names(cenvs)) if (length(missing) > 0) do.call(Sys.setenv, as.list(oenvs0[missing])) ## (c) Modified? for (name in intersect(names(cenvs), names(oenvs0))) { ## WORKAROUND: On Linux Wine, base::Sys.getenv() may ## return elements with empty names. /HB 2016-10-06 if (nchar(name) == 0) next if (!identical(cenvs[[name]], oenvs0[[name]])) { do.call(Sys.setenv, as.list(oenvs0[name])) } } ## (d) Assert that everything was undone stopifnot(identical(Sys.getenv(), oenvs0)) ## Undo variables rm(list = c(setdiff(ls(), ovars))) globals/tests/utils.R0000644000176200001440000000773213557155442014346 0ustar liggesuserssource("incl/start.R") message("*** utils ...") message("- envname() ...") name <- envname(NULL) print(name) stopifnot(is.character(name), length(name) == 1L, is.na(name)) env <- new.env() print(env) name <- utils::capture.output(print(env)) stopifnot(is.character(name), length(name) == 1L) name <- envname(env) print(name) stopifnot(is.character(name), length(name) == 1L, !is.na(name), class(env) == "environment") env <- structure(new.env(), class = "foo") print.foo <- function(x, ...) { str(as.list(letters[1:3])); invisible(x) } print(env) name <- utils::capture.output(print(env)) stopifnot(is.character(name), length(name) > 1L) name <- envname(env) print(name) stopifnot(is.character(name), length(name) == 1L, !is.na(name), class(env) == "foo") message("- envname() ... DONE") message("* hpaste() ...") printf <- function(...) cat(sprintf(...)) hpaste <- globals:::hpaste # Some vectors x <- 1:6 y <- 10:1 z <- LETTERS[x] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Abbreviation of output vector # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - printf("x = %s.\n", hpaste(x)) ## x = 1, 2, 3, ..., 6. printf("x = %s.\n", hpaste(x, max_head = 2)) ## x = 1, 2, ..., 6. printf("x = %s.\n", hpaste(x), max_head = 3) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 printf("x = %s.\n", hpaste(x, max_head = 4)) ## x = 1, 2, 3, 4, 5 and 6. # Showing the tail printf("x = %s.\n", hpaste(x, max_head = 1, max_tail = 2)) ## x = 1, ..., 5, 6. # Turning off abbreviation printf("y = %s.\n", hpaste(y, max_head = Inf)) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ## ...or simply printf("y = %s.\n", paste(y, collapse = ", ")) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 # Change last separator printf("x = %s.\n", hpaste(x, last_collapse = " and ")) ## x = 1, 2, 3, 4, 5 and 6. # No collapse stopifnot(all(hpaste(x, collapse = NULL) == x)) # Empty input stopifnot(identical(hpaste(character(0)), character(0))) message("* hpaste() ... DONE") message("* as_function() ...") fcn <- as_function({ 1 }) print(fcn()) stopifnot(fcn() == 1) message("* is_base_pkg() ...") base_pkgs <- c("base") for (pkg in base_pkgs) { stopifnot(is_base_pkg(pkg)) } stopifnot(!is_base_pkg("globals")) message("* is.base() & is_internal() ...") stopifnot(is.base(base::library)) stopifnot(!is.base(globals::globalsOf)) stopifnot(!is.base(NULL)) stopifnot(is_internal(print.default)) stopifnot(!is_internal(globals::globalsOf)) stopifnot(!is_internal(NULL)) message("* where() ...") env <- where("sample", where = 1L) str(env) env <- where("sample", frame = 1L) str(env) message("- where('sample') ...") env <- where("sample", mode = "function") print(env) if (!"covr" %in% loadedNamespaces()) { stopifnot(identical(env, baseenv())) } obj <- get("sample", mode = "function", envir = env, inherits = FALSE) stopifnot(identical(obj, base::sample)) message("- where('sample', mode = 'integer') ...") env <- where("sample", mode = "integer") print(env) stopifnot(is.null(env)) message("- where('sample2') ...") sample2 <- base::sample env <- where("sample2", mode = "function") print(env) stopifnot(identical(env, environment())) obj <- get("sample2", mode = "function", envir = env, inherits = FALSE) stopifnot(identical(obj, sample2)) message("- where() - local objects of functions ...") aa <- 1 foo <- function() { bb <- 2 #nolint list(aa = where("aa"), bb = where("bb"), cc = where("cc"), envir = environment()) } envs <- foo() str(envs) stopifnot(identical(envs$aa, globalenv())) stopifnot(identical(envs$bb, envs$envir)) stopifnot(is.null(envs$cc)) message("- where() - missing ...") env <- where("non-existing-object", inherits = FALSE) stopifnot(is.null(env)) rm(list = c("aa", "envs", "foo", "env", "obj", "where")) message("* where() ... DONE") message("- mdebug() ...") mdebug("Message A") oopts <- options(globals.debug = TRUE) mdebug("Message B") options(oopts) message("* mdebug() ... DONE") message("*** utils ... DONE") source("incl/end.R") globals/tests/zzz.R0000644000176200001440000000003513557155312014024 0ustar liggesusers## Just a dummy place holder globals/tests/conservative.R0000644000176200001440000000365213557155442015713 0ustar liggesuserssource("incl/start.R") ## WORKAROUND: Avoid problem reported in testthat Issue #229, which ## causes covr::package_coverage() to given an error. /HB 2015-02-16 suppressWarnings({ rm(list = c("a", "b", "c", "x", "y", "z", "square", "pathname", "url", "filename")) }) message("Setting up expressions") exprs <- list( A = quote({ Sys.sleep(1) x <- 0.1 }), B = quote({ y <- 0.2 }), C = quote({ z <- a + 0.3 }), D = quote({ pathname <- file.path(dirname(url), filename) }), E = quote({ b <- c }), F = quote({ a <- { runif(1) } b <- { rnorm(1) } x <- a * b abs(x) }), G = quote({ y <- square(a) }), H = quote({ b <- a a <- 1 }) ) atleast <- list( A = c(), B = c(), C = c("a"), D = c("filename"), E = c("c"), F = c(), G = c("a", "square"), H = c() ## FIXME: Should be c("a"), cf. Issue #5. ) not <- list( A = c("x"), B = c("y"), C = c("z"), D = c("pathname"), E = c("b"), F = c("a", "b", "x"), G = c(), H = c() ) ## Define globals a <- 3.14 c <- 2.71 square <- function(x) x ^ 2 filename <- "index.html" # Yes, pretend we forget 'url' message("Find globals") for (kk in seq_along(exprs)) { key <- names(exprs)[kk] expr <- exprs[[key]] cat(sprintf("Expression #%d ('%s'):\n", kk, key)) print(expr) names <- findGlobals(expr, method = "conservative") cat(sprintf("Globals: %s\n", paste(sQuote(names), collapse = ", "))) stopifnot(all(atleast[[key]] %in% names)) stopifnot(!any(names %in% not[[key]])) globals <- globalsOf(expr, method = "conservative") cat(sprintf("Globals: %s\n", paste(sQuote(names(globals)), collapse = ", "))) stopifnot(all(atleast[[key]] %in% names(globals))) stopifnot(!any(names(globals) %in% not[[key]])) str(globals) cat("\n") } names <- findGlobals(exprs, method = "conservative", unlist = TRUE) cat(sprintf("Globals: %s\n", paste(sQuote(names), collapse = ", "))) ## Cleanup source("incl/end.R") globals/tests/Globals.R0000644000176200001440000001433313557155442014564 0ustar liggesuserssource("incl/start.R") a <- 1 b <- 2 message("*** Globals() ...") globals0 <- globalsByName(c("a", "rnorm")) globals <- globals0 str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == c("a", "rnorm")), all(names(globals) == names(where)) ) message("*** Globals() - names ...") globals <- globals0 str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == c(names(globals0))), all(names(globals) == names(where)) ) names(globals)[1] <- "A" str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == c("A", names(globals0)[-1])), all(names(globals) == names(where)) ) message("*** Globals() - names ... DONE") message("*** Globals() - subsetting ...") globals <- globals0[1] str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 1L, length(where) == length(globals), all(names(globals) == c("a")), all(names(globals) == names(where)) ) globals <- globals0[2] str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 1L, length(where) == length(globals), all(names(globals) == c("rnorm")), all(names(globals) == names(where)) ) globals <- globals0[2:1] str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == c("rnorm", "a")), all(names(globals) == names(where)) ) ## rev() works automatically thanks to `[`() :) globals <- rev(globals0) str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == rev(names(globals0))), all(names(globals) == names(where)), identical(rev(globals), globals0) ) message("*** Globals() - subsetting ... DONE") message("*** Globals() - subsetted assignment ...") globals <- globals0 globals$a <- globals0["a"] str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == names(globals0)), all(names(globals) == names(where)), identical(globals, globals0) ) globals <- globals0 globals$b <- globals0["a"] str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 3L, length(where) == length(globals), all(names(globals) == c(names(globals0), "b")), all(names(globals) == names(where)), identical(globals$b, globals0$a) ) globals <- globals0 globals$a <- NULL str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 1L, length(where) == length(globals), all(names(globals) == names(globals0)[-1]), all(names(globals) == names(where)), is.null(globals$a) ) globals <- globals0 globals$a <- 1:2 str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == names(globals0)), all(names(globals) == names(where)), identical(globals$a, 1:2) ) message("*** Globals() - subsetted assignment ... DONE") message("*** Globals() - combining ...") globals_a <- globals0[1:2] globals_b <- globals0[1:2] globals <- c(globals_a, globals_b) str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 4L, length(where) == length(globals), all(names(globals) == c(names(globals_a), names(globals_b))), all(names(globals) == names(where)) ) globals_a <- globals0[1:2] globals_b <- list(b = 1, c = letters) globals <- c(globals_a, globals_b) str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 4L, length(where) == length(globals), all(names(globals) == c(names(globals_a), names(globals_b))), all(names(globals) == names(where)) ) globals_a <- globals0[1:2] globals_b <- list() globals <- c(globals_a, globals_b) str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 2L, length(where) == length(globals), all(names(globals) == c(names(globals_a), names(globals_b))), all(names(globals) == names(where)) ) globals_a <- globals0[1:2] globals <- c(globals_a, b = 1, c = letters) str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 4L, length(where) == length(globals), all(names(globals) == c(names(globals_a), "b", "c")), all(names(globals) == names(where)) ) message("*** Globals() - combining ... DONE") message("*** Globals() - unique ...") globals <- globals0[c(1:2, 1:2, 1:2)] str(globals) where <- attr(globals, "where") stopifnot( length(globals) == 6L, length(where) == length(globals), all(names(globals) == rep(names(globals0), times = 3L)), all(names(globals) == names(where)) ) globals <- unique(globals) str(globals) where <- attr(globals, "where") stopifnot( length(globals) == length(globals0), length(where) == length(globals), all(names(globals) == names(globals0)), all(names(globals) == names(where)) ) message("*** Globals() - unique ... DONE") message("*** Globals() - coercion ...") globals <- as.Globals(globals0) stopifnot(identical(globals, globals0)) globals <- as.Globals(unclass(globals0)) stopifnot(identical(globals, globals0)) globals_t <- unclass(globals0) attr(globals_t, "where") <- NULL globals <- as.Globals(globals_t) stopifnot( length(globals) == length(globals0), names(globals) == names(globals0) ) message("*** Globals() - coercion ... DONE") message("*** Globals() - empty ...") globals <- Globals() globals <- Globals(list()) globals <- as.Globals(list()) message("*** Globals() - empty ... DONE") message("*** Globals() - exceptions ...") res <- tryCatch({ Globals(NULL) }, error = identity) stopifnot(inherits(res, "simpleError")) res <- tryCatch({ Globals(list(1, 2)) }, error = identity) stopifnot(inherits(res, "simpleError")) res <- tryCatch({ Globals(list(a = 1, 2)) }, error = identity) stopifnot(inherits(res, "simpleError")) ## Assigning more than one element globals <- globals0 res <- tryCatch({ globals$a <- globals0[2:1] }, error = identity) stopifnot(inherits(res, "simpleError")) ## Appending unnamed objects res <- tryCatch({ c(globals0, 2) }, error = identity) stopifnot(inherits(res, "simpleError")) message("*** Globals() - exceptions ... DONE") message("*** Globals() ... DONE") source("incl/end.R") globals/tests/findGlobals.R0000644000176200001440000000750413557345411015424 0ustar liggesuserssource("incl/start.R") message("*** findGlobals() ...") message(" ** findGlobals(..., method = 'conservative'):") expr <- exprs$A globals_c <- findGlobals(expr, method = "conservative") print(globals_c) assert_identical_sets(globals_c, c("{", "<-", "c", "d", "+")) message(" ** findGlobals(..., method = 'liberal'):") expr <- exprs$A globals_l <- findGlobals(expr, method = "liberal") print(globals_l) assert_identical_sets(globals_l, c("{", "<-", "b", "c", "d", "+", "a", "e")) message(" ** findGlobals(..., method = 'ordered'):") expr <- exprs$A globals_i <- findGlobals(expr, method = "ordered") print(globals_i) assert_identical_sets(globals_i, c("{", "<-", "b", "c", "d", "+", "a", "e")) globals_i <- findGlobals(function() { a <- a + 1 a }) print(globals_i) assert_identical_sets(globals_i, c("{", "<-", "a", "+")) globals_i <- findGlobals(function() { a a <- a + 1 }) print(globals_i) if (packageVersion("globals") <= "0.12.4") { assert_identical_sets(globals_i, c("{", "<-", "+")) } else { assert_identical_sets(globals_i, c("{", "a", "<-", "+")) } message(" ** findGlobals(..., tweak):") tweak_another_expression <- function(expr) { quote({ x <- B B <- 1 y <- C z <- D }) } expr <- exprs$A globals_i <- findGlobals(expr, tweak = tweak_another_expression) assert_identical_sets(globals_i, c("{", "<-", "B", "C", "D")) message(" ** findGlobals(..., trace = TRUE):") expr <- exprs$A globals_i <- findGlobals(expr, trace = TRUE) print(globals_i) assert_identical_sets(globals_i, c("{", "<-", "b", "c", "d", "+", "a", "e")) message(" ** findGlobals(a <- pkg::a):") expr <- exprs$B globals_i <- findGlobals(expr) print(globals_i) assert_identical_sets(globals_i, c("<-", "::")) message(" ** findGlobals(a[1] <- 0) etc.:") globals_i <- findGlobals(a[1] <- 0, substitute = TRUE) print(globals_i) false_globals <- "[" assert_identical_sets(setdiff(globals_i, false_globals), c("<-", "a", "[<-")) globals_i <- findGlobals({ a[1] = 0 }, substitute = TRUE) print(globals_i) false_globals <- "[" assert_identical_sets(setdiff(globals_i, false_globals), c("{", "=", "a", "[<-")) globals_i <- findGlobals(a[b <- 1] <- 0, substitute = TRUE) print(globals_i) false_globals <- "[" assert_identical_sets(setdiff(globals_i, false_globals), c("<-", "a", "[<-")) globals_i <- findGlobals(a[b = 1] <- 0, substitute = TRUE) print(globals_i) false_globals <- "[" assert_identical_sets(setdiff(globals_i, false_globals), c("<-", "a", "[<-")) globals_i <- findGlobals({ a[b <- 1] = 0 }, substitute = TRUE) print(globals_i) false_globals <- "[" assert_identical_sets(setdiff(globals_i, false_globals), c("{", "=", "a", "<-", "[<-")) globals_i <- findGlobals(a$b <- 0, substitute = TRUE) print(globals_i) false_globals <- "$" assert_identical_sets(setdiff(globals_i, false_globals), c("<-", "a", "$<-")) globals_i <- findGlobals({ a$b = 0 }, substitute = TRUE) print(globals_i) false_globals <- "$" assert_identical_sets(setdiff(globals_i, false_globals), c("{", "=", "a", "$<-")) globals_i <- findGlobals(names(a) <- "A", substitute = TRUE) print(globals_i) assert_identical_sets(globals_i, c("<-", "a", "names", "names<-")) globals_i <- findGlobals({ names(a) = "A" }, substitute = TRUE) print(globals_i) assert_identical_sets(globals_i, c("{", "=", "a", "names", "names<-")) ## In order to handle the following case, we have to accept a few ## false positives (`[`, `[[`, `$`, `[<-`, `[[<-`) globals_i <- findGlobals(names(a)[1] <- "A", substitute = TRUE) print(globals_i) false_globals <- c("[", "[<-") assert_identical_sets(setdiff(globals_i, false_globals), c("<-", "a", "names", "names<-")) globals_i <- findGlobals({ names(a)[1] = "A" }, substitute = TRUE) print(globals_i) false_globals <- c("[", "[<-") assert_identical_sets(setdiff(globals_i, false_globals), c("{", "=", "a", "names", "names<-")) message("*** findGlobals() ... DONE") source("incl/end.R") globals/tests/walkAST.R0000644000176200001440000000571513557155442014513 0ustar liggesuserssource("incl/start.R") message("*** walkAST() ...") exprs <- list( null = quote(NULL), atomic = quote(1), atomic = quote("a"), atomic = quote(TRUE), assign = quote(a <- 1), assign = quote(1 -> a), assign = quote(a <- b + 1), assign = quote(x <- rnorm(20, mu = 0)), index = quote(x[1, 1]), index = quote(x[1:2, 1:2]), index = quote(x[, 1:2]), index = quote(x[, 1]), fcn = quote(function(a = 1, b = 2) sum(c(a, b))), fcn = quote(function(a = 1, b) sum(c(a, b))), fcn = quote(function(a = 1, b = 2, ...) sum(c(a, b, ...))), fcn = quote(function(a = NULL) a), ok = quote(function(...) sum(x, ...)), warn = quote(sum(x, ...)), null = quote(NULL), builtin = base::length, closure = function() NULL, closure = function() a, closure = function(x = 0) a * x, special = base::log, list = substitute(FUN(a = A), list(A = list())), pairlist = substitute(FUN(a = A), list(A = pairlist(a = 1))), expression = substitute(FUN(a = A), list(A = expression())) # environment = new.env() ) if (requireNamespace("methods")) { exprs$s4 <- methods::getClass("MethodDefinition") } nullify <- function(e) NULL disp <- function(expr) { cat("Expression:\n") print(expr) cat("str():\n") str(expr) cat(sprintf("typeof: %s\n", typeof(expr))) if (is.recursive(expr)) { cat("as.list():\n") str(as.list(expr)) } expr } ## disp() for (kk in seq_along(exprs)) { name <- names(exprs)[kk] message(sprintf("- walkAST() ...", kk, sQuote(name))) expr <- exprs[[kk]] disp(expr) ## Assert identity (default behavior) expr_i <- walkAST(expr) disp(expr_i) stopifnot(length(expr_i) == length(expr), identical(expr_i, expr)) ## Display the AST tree walkAST(expr, atomic = disp, name = disp, call = disp, pairlist = disp) ## Nullify expr_n <- walkAST(expr, atomic = nullify, name = nullify, call = nullify, pairlist = nullify) disp(expr_n) message("*** walkAST() - nullify ... DONE") message(sprintf("- walkAST() ... DONE", kk, sQuote(name))) } ## for (name ...) message("*** walkAST() - substitute = TRUE ...") expr <- walkAST(a <- 1, substitute = TRUE) print(expr) message("*** walkAST() - substitute = TRUE ... DONE") message("*** walkAST() - exceptions ...") f <- function(...) get("...") expr <- f(NULL) options(globals.walkAST.onUnknownType = "error") res <- tryCatch({ walkAST(expr) }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) options(globals.walkAST.onUnknownType = "warning") foo <- walkAST(expr) res <- tryCatch({ walkAST(expr) }, warning = identity) print(res) stopifnot(inherits(res, "simpleWarning")) options(globals.walkAST.onUnknownType = "error") message("*** walkAST() - exceptions ... DONE") message("*** walkAST() ... DONE") source("incl/end.R") globals/tests/globalsOf.R0000644000176200001440000001357513557174461015122 0ustar liggesuserssource("incl/start.R") message("*** globalsOf() ...") message(" ** globalsOf(..., method = 'conservative'):") expr <- exprs$A globals_c <- globalsOf(expr, method = "conservative") str(globals_c) assert_identical_sets(names(globals_c), c("{", "<-", "c", "d", "+")) globals_c <- cleanup(globals_c) str(globals_c) assert_identical_sets(names(globals_c), c("c", "d")) where <- attr(globals_c, "where") stopifnot( length(where) == length(globals_c), identical(where$c, globalenv()), identical(where$d, globalenv()) ) message(" ** globalsOf(..., method = 'liberal'):") expr <- exprs$A globals_l <- globalsOf(expr, method = "liberal") str(globals_l) assert_identical_sets(names(globals_l), c("{", "<-", "b", "c", "d", "+", "a", "e")) globals_l <- cleanup(globals_l) str(globals_l) assert_identical_sets(names(globals_l), c("b", "c", "d", "a", "e")) where <- attr(globals_l, "where") stopifnot( length(where) == length(globals_l), identical(where$b, globalenv()), identical(where$c, globalenv()), identical(where$d, globalenv()) ) message(" ** globalsOf(..., method = 'ordered'):") expr <- exprs$A globals_i <- globalsOf(expr, method = "ordered") str(globals_i) assert_identical_sets(names(globals_i), c("{", "<-", "b", "c", "d", "+", "a", "e")) globals_i <- cleanup(globals_i) str(globals_i) assert_identical_sets(names(globals_i), c("b", "c", "d", "a", "e")) where <- attr(globals_i, "where") stopifnot( length(where) == length(globals_i), identical(where$b, globalenv()), identical(where$c, globalenv()), identical(where$d, globalenv()) ) message(" ** globalsOf() w/ globals in local functions:") a <- 1 bar <- function(x) x - a foo <- function(x) bar(x) for (method in c("ordered", "conservative", "liberal")) { globals <- globalsOf({ foo(3) }, substitute = TRUE, method = method, recursive = FALSE, mustExist = FALSE) assert_identical_sets(names(globals), c("{", "foo")) stopifnot(!any("a" %in% names(globals))) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("foo")) stopifnot(!any("a" %in% names(globals))) globals <- globalsOf({ foo(3) }, substitute = TRUE, method = "ordered", recursive = TRUE, mustExist = FALSE) assert_identical_sets(names(globals), c("{", "foo", "bar", "-", "a")) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("foo", "bar", "a")) globals <- globalsOf({ foo(3) }, substitute = TRUE, recursive = TRUE, mustExist = FALSE) assert_identical_sets(names(globals), c("{", "foo", "bar", "-", "a")) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("foo", "bar", "a")) } message(" ** globalsOf() w/ recursive functions:") ## "Easy" f <- function() Recall() globals <- globalsOf(f) str(globals) ## Direct recursive call f <- function() f() globals <- globalsOf(f) str(globals) ## Indirect recursive call f <- function() g() g <- function() f() globals_f <- globalsOf(f) str(globals_f) globals_g <- globalsOf(g) str(globals_g) globals_f <- globals_f[order(names(globals_f))] globals_g <- globals_g[order(names(globals_g))] stopifnot(identical(globals_g, globals_f)) message("*** globalsOf() ... DONE") message("*** Subsetting of Globals:") expr <- exprs$A globals_l <- globalsOf(expr, method = "liberal") globals_s <- globals_l[-1] stopifnot(length(globals_s) == length(globals_l) - 1L) stopifnot(identical(class(globals_s), class(globals_l))) where_l <- attr(globals_l, "where") where_s <- attr(globals_s, "where") stopifnot(length(where_s) == length(where_l) - 1L) stopifnot(identical(where_s, where_l[-1])) message("*** cleanup() & packagesOf():") expr <- exprs$A globals <- globalsOf(expr, method = "conservative") str(globals) assert_identical_sets(names(globals), c("{", "<-", "c", "d", "+")) globals <- as.Globals(globals) str(globals) assert_identical_sets(names(globals), c("{", "<-", "c", "d", "+")) globals <- as.Globals(unclass(globals)) str(globals) assert_identical_sets(names(globals), c("{", "<-", "c", "d", "+")) pkgs <- packagesOf(globals) print(pkgs) stopifnot(length(pkgs) == 0L) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("c", "d")) pkgs <- packagesOf(globals) print(pkgs) stopifnot(length(pkgs) == 0L) message("*** globalsOf() and package functions:") foo <- globals::Globals expr <- exprs$C globals <- globalsOf(expr, recursive = FALSE) str(globals) assert_identical_sets(names(globals), c("{", "foo", "list")) where <- attr(globals, "where") stopifnot(length(where) == length(globals)) if (!covr) stopifnot( identical(where$`{`, baseenv()), identical(where$foo, globalenv()), identical(where$list, baseenv()) ) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("foo")) pkgs <- packagesOf(globals) stopifnot(pkgs == "globals") message("*** globalsOf() and core-package functions:") sample2 <- base::sample sum2 <- base::sum expr <- exprs$D globals <- globalsOf(expr, recursive = FALSE) str(globals) assert_identical_sets(names(globals), c("{", "<-", "sample", "sample2", "sessionInfo", "sum", "sum2")) where <- attr(globals, "where") stopifnot(length(where) == length(globals)) if (!covr) stopifnot( identical(where$`<-`, baseenv()), identical(where$sample, baseenv()), identical(where$sample2, globalenv()) ) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("sample2", "sum2")) where <- attr(globals, "where") stopifnot(length(where) == length(globals)) if (!covr) stopifnot(identical(where$sample2, globalenv())) globals <- cleanup(globals, drop = "primitives") str(globals) assert_identical_sets(names(globals), c("sample2")) message("*** globalsOf() - exceptions ...") rm(list = "a") res <- try({ globals <- globalsOf({ x <- a }, substitute = TRUE, mustExist = TRUE) }, silent = TRUE) stopifnot(inherits(res, "try-error")) message("*** globalsOf() - exceptions ... DONE") source("incl/end.R") globals/tests/liberal.R0000644000176200001440000000364213557155442014614 0ustar liggesuserssource("incl/start.R") ## WORKAROUND: Avoid problem reported in testthat Issue #229, which ## causes covr::package_coverage() to given an error. /HB 2015-02-16 suppressWarnings({ rm(list = c("a", "b", "c", "x", "y", "z", "square", "pathname", "url", "filename")) }) message("Setting up expressions") exprs <- list( A = quote({ Sys.sleep(1) x <- 0.1 }), B = quote({ y <- 0.2 }), C = quote({ z <- a + 0.3 }), D = quote({ pathname <- file.path(dirname(url), filename) }), E = quote({ b <- c }), F = quote({ a <- { runif(1) } b <- { rnorm(1) } x <- a * b abs(x) }), G = quote({ y <- square(a) }), H = quote({ b <- a a <- 1 }) ) atleast <- list( A = c(), B = c(), C = c("a"), D = c("filename"), E = c("c"), F = c(), G = c("a", "square"), H = c() ## FIXME: Should be c("a"), cf. Issue #5. ) not <- list( A = c("x"), B = c("y"), C = c("z"), D = c("pathname"), E = c("b"), F = c(), G = c(), H = c() ) ## Define globals a <- 3.14 c <- 2.71 square <- function(x) x ^ 2 filename <- "index.html" # Yes, pretend we forget 'url' message("Find globals") for (kk in seq_along(exprs)) { key <- names(exprs)[kk] expr <- exprs[[key]] cat(sprintf("Expression #%d ('%s'):\n", kk, key)) print(expr) names <- findGlobals(expr, method = "liberal") cat(sprintf("Globals: %s\n", paste(sQuote(names), collapse = ", "))) stopifnot(all(atleast[[key]] %in% names)) stopifnot(!any(names %in% not[[key]])) globals <- globalsOf(expr, method = "liberal", mustExist = FALSE) cat(sprintf("Globals: %s\n", paste(sQuote(names(globals)), collapse = ", "))) stopifnot(all(atleast[[key]] %in% names(globals))) stopifnot(!any(names(globals) %in% not[[key]])) str(globals) cat("\n") } names <- findGlobals(exprs, method = "liberal", unlist = TRUE) cat(sprintf("Globals: %s\n", paste(sQuote(names), collapse = ", "))) ## Cleanup source("incl/end.R") globals/tests/formulas.R0000644000176200001440000000125013557174461015025 0ustar liggesuserssource("incl/start.R") message("findGlobals() with formula ...") g <- findGlobals(. ~ x + y : z, substitute = TRUE) print(g) assert_identical_sets(g, c("~", ".", "+", "x", ":", "y", "z")) g <- findGlobals(map(1L, ~ typeof(.x)), substitute = TRUE) print(g) assert_identical_sets(g, c("map", "~", "typeof", ".x")) message("findGlobals() with formula ... DONE") message("globalsOf() with formula ...") foo <- function(x) { map(1L, ~ typeof(x + .x)) } g <- globalsOf(foo(1L), substitute = TRUE, mustExist = FALSE) str(g) assert_identical_sets(names(g), c("foo", "map", "{", "~", "typeof", "+", "x", ".x")) message("globalsOf() with formula ... DONE") source("incl/end.R") globals/tests/globalsByName.R0000644000176200001440000000507413557174461015724 0ustar liggesuserssource("incl/start.R") message("*** globalsByName() ...") globals_c <- globalsByName(c("{", "<-", "c", "d")) str(globals_c) assert_identical_sets(names(globals_c), c("{", "<-", "c", "d")) globals_c <- cleanup(globals_c) str(globals_c) assert_identical_sets(names(globals_c), c("c", "d")) where <- attr(globals_c, "where") stopifnot( length(where) == length(globals_c), identical(where$c, globalenv()), identical(where$d, globalenv()) ) foo <- globals::Globals globals <- globalsByName(c("{", "foo", "list"), recursive = FALSE) str(globals) assert_identical_sets(names(globals), c("{", "foo", "list")) where <- attr(globals, "where") stopifnot(length(where) == length(globals)) if (!covr) stopifnot( identical(where$`{`, baseenv()), identical(where$foo, globalenv()), identical(where$list, baseenv()) ) globals <- cleanup(globals) str(globals) assert_identical_sets(names(globals), c("foo")) globals <- cleanup(globals, drop = "internals") str(globals) assert_identical_sets(names(globals), c("foo")) pkgs <- packagesOf(globals) stopifnot(pkgs == "globals") ## Also '...' myGlobals <- function(x, ...) { globalsByName(c("a", "x", "...")) } globals <- myGlobals(x = 2, y = 3, z = 4) str(globals) assert_identical_sets(names(globals), c("a", "x", "...")) assert_identical_sets(names(globals[["..."]]), c("y", "z")) ## BUG FIX: Assert that '...' does not have to be specified at the end myGlobals <- function(x, ...) { globalsByName(c("a", "...", "x")) } globals <- myGlobals(x = 2, y = 3, z = 4) str(globals) assert_identical_sets(names(globals), c("a", "x", "...")) assert_identical_sets(names(globals[["..."]]), c("y", "z")) ## Test with arguments defaulting to other arguments myGlobals <- function(x, y, z = y) { globalsByName(c("a", "x", "y", "z")) } globals <- myGlobals(x = 2, y = 3) assert_identical_sets(names(globals), c("a", "x", "y", "z")) stopifnot(globals$y == 3, identical(globals$z, globals$y)) globals <- myGlobals(x = 2, y = 3, z = 4) assert_identical_sets(names(globals), c("a", "x", "y", "z")) stopifnot(globals$y == 3, globals$z == 4) myGlobals <- function(x, ...) { globalsByName(c("a", "x", "...")) } globals <- myGlobals(x = 2, y = 3) assert_identical_sets(names(globals), c("a", "x", "...")) assert_identical_sets(names(globals[["..."]]), c("y")) stopifnot(globals[["..."]]$y == 3) globals <- myGlobals(x = 2, y = 3, z = 4) assert_identical_sets(names(globals), c("a", "x", "...")) assert_identical_sets(names(globals[["..."]]), c("y", "z")) stopifnot(globals[["..."]]$y == 3, globals[["..."]]$z == 4) message("*** globalsByName() ... DONE") source("incl/end.R") globals/tests/dotdotdot.R0000644000176200001440000001352413557174461015210 0ustar liggesuserssource("incl/start.R") options(warn = 1L) exprs <- list( ok = quote(function(...) sum(x, ...)), warn = quote(sum(x, ...)) ) message("*** findGlobals() ...") for (name in names(exprs)) { expr <- exprs[[name]] message("\n*** codetools::findGlobals():") fun <- globals:::as_function(expr) print(fun) globals <- codetools::findGlobals(fun) print(globals) assert_identical_sets(globals, c("sum", "x")) message("\n*** findGlobals(dotdotdot = 'ignore'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- findGlobals(expr, dotdotdot = "ignore") print(globals) assert_identical_sets(globals, c("sum", "x")) message("\n*** findGlobals(dotdotdot = 'return'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- findGlobals(expr, dotdotdot = "return") print(globals) if (name == "ok") { assert_identical_sets(globals, c("sum", "x")) } else { assert_identical_sets(globals, c("sum", "x", "...")) } message("\n*** findGlobals(dotdotdot = 'warn'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- findGlobals(expr, dotdotdot = "warn") print(globals) if (name == "ok") { assert_identical_sets(globals, c("sum", "x")) } else { assert_identical_sets(globals, c("sum", "x", "...")) } message("\n*** findGlobals(dotdotdot = 'error'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- tryCatch(findGlobals(expr, dotdotdot = "error"), error = identity) if (name == "ok") { assert_identical_sets(globals, c("sum", "x")) } else { stopifnot(inherits(globals, "error")) } } # for (name ...) message("\n*** findGlobals(, dotdotdot = 'return'):") print(exprs) globals <- findGlobals(exprs, dotdotdot = "return") print(globals) message("*** findGlobals() ... DONE") message("*** globalsOf() ...") x <- 1:2 for (name in names(exprs)) { expr <- exprs[[name]] message("\n*** globalsOf(dotdotdot = 'ignore'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- globalsOf(expr, dotdotdot = "ignore") print(globals) assert_identical_sets(names(globals), c("sum", "x")) stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) message("\n*** globalsOf(dotdotdot = 'return'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- globalsOf(expr, dotdotdot = "return") print(globals) if (name == "ok") { assert_identical_sets(names(globals), c("sum", "x")) } else { assert_identical_sets(names(globals), c("sum", "x", "...")) stopifnot(!is.list(globals$`...`) && is.na(globals$`...`)) } stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) message("\n*** globalsOf(dotdotdot = 'warn'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- globalsOf(expr, dotdotdot = "warn") print(globals) if (name == "ok") { assert_identical_sets(names(globals), c("sum", "x")) } else { assert_identical_sets(names(globals), c("sum", "x", "...")) stopifnot(!is.list(globals$`...`) && is.na(globals$`...`)) } stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) message("\n*** globalsOf(dotdotdot = 'error'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- tryCatch(globalsOf(expr, dotdotdot = "error"), error = identity) if (name == "ok") { assert_identical_sets(names(globals), c("sum", "x")) stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) } else { stopifnot(inherits(globals, "error")) } } # for (name ...) message("\n*** globalsOf(, dotdotdot = 'return'):") print(exprs) globals <- globalsOf(exprs, dotdotdot = "return") print(globals) message("*** globalsOf() ... DONE") message("*** function(x, ...) globalsOf() ...") aux <- function(x, ..., exprs) { args <- list(...) for (name in names(exprs)) { expr <- exprs[[name]] message("\n*** globalsOf(dotdotdot = 'ignore'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- globalsOf(expr, dotdotdot = "ignore") print(globals) assert_identical_sets(names(globals), c("sum", "x")) stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) message("\n*** globalsOf(dotdotdot = 'return'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- globalsOf(expr, dotdotdot = "return") print(globals) if (name == "ok") { assert_identical_sets(names(globals), c("sum", "x")) } else { assert_identical_sets(names(globals), c("sum", "x", "...")) stopifnot(all.equal(globals$`...`, args, check.attributes = FALSE)) } stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) message("\n*** globalsOf(dotdotdot = 'warn'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- globalsOf(expr, dotdotdot = "warn") print(globals) if (name == "ok") { assert_identical_sets(names(globals), c("sum", "x")) } else { assert_identical_sets(names(globals), c("sum", "x", "...")) stopifnot(all.equal(globals$`...`, args, check.attributes = FALSE)) } stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) message("\n*** globalsOf(dotdotdot = 'error'):") cat(sprintf("Expression '%s':\n", name)) print(expr) globals <- tryCatch(globalsOf(expr, dotdotdot = "error"), error = identity) if (name == "ok") { assert_identical_sets(names(globals), c("sum", "x")) stopifnot(all.equal(globals$sum, base::sum)) stopifnot(all.equal(globals$x, x)) } else { stopifnot(inherits(globals, "error")) } } # for (name ...) message("\n*** globalsOf(, dotdotdot = 'return'):") print(exprs) globals <- globalsOf(exprs, dotdotdot = "return") print(globals) } # aux() aux(x = 3:4, y = 1, z = 42L, exprs = exprs) message("*** function(x, ...) globalsOf() ... DONE") ## Cleanup source("incl/end.R") globals/NEWS0000644000176200001440000001720713573005645012413 0ustar liggesusersPackage: globals ================ Version: 0.12.5 [2019-12-07] BUG FIXES: * findGlobals(function() { a; a <- a + 1 }) would fail to identify 'a' as a global variable whereas it was properly identified with { a <- a + 1; a }. Version: 0.12.4 [2018-10-11] BUG FIXES: * globalsOf() could produce "Error in vapply(where, FUN = envname, FUN.VALUE = NA_character_, USE.NAMES = FALSE) : values must be length 1, but FUN(X[[...]]) result is length ...". This was because the internal envname(env) did not always handle when class(env) != "environment". Version: 0.12.3 [2018-09-16] NEW FEATURES: * findGlobals(), globalsOf(), and packagesOf() no longer return elements sorted by name. BUG FIXES: * globals::findGlobals() would not identify 'a' as a global in expressions of type 'a[1] = ...' and 'names(a) = ...' although it did for 'a[1] <- ...' and 'names(a) <- ...'. Version: 0.12.2 [2018-08-25] PERFORMANCE: * cleanup() for Globals should now be much faster. Previously, it could be very slow the first time it was called in a fresh R session, especially if the user had a large number of packages installed and/or the package libraries were on slow drives. DOCUMENTAITON: * Added help for globals::findGlobals(). BUG FIXES: * globals::findGlobals(x), where 'x' is a list, iterated over 'x' incorrectly assuming no method dispatching on 'x' would take place. For instance, if 'x' contained an fst::fst_table object, then "Error in .subset2(x, i, exact = exact) : subscript out of bounds" would be produced. * globals::findGlobals() could produce a "Warning in is.na(x): is.na() applied to non-(list or vector) of type 'NULL'" in R (< 3.5.0). Version: 0.12.1 [2018-06-24] PERFORMANCE: * globals::findGlobals() is now significantly faster for elements that are long lists with many elements of basic data types. This is because elements of such basic data type cannot contain globals and can therefore be skipped early in the search for globals. Version: 0.12.0 [2018-06-12] NEW FEATURES: * Now globals::findGlobals() identifies 'a' as a global also when it is part of LHS expressions of type 'a[1] <- ...' and 'names(a) <- ...'. BUG FIXES: * globals::findGlobals() incorrectly identified 'a' as a global in expression of type 'a <- pkg::a'. * If "..." was passed to globalsByName(names), an error would be produced unless it was the last entry in 'names'. Version: 0.11.0 [2018-01-09] NEW FEATURES: o Now findGlobals() identifies 'x' as a global variable in 'x <- x + 1' and likewise for x + 1 -> x. Note that ditto using `<<-` and `->>` was already identifying 'x' as a global. BUG FIXES: o findGlobals(..., trace = TRUE) now outputs only to standard error. Previously, some of the output went to standard output. Version: 0.10.3 [2017-10-12] BUG FIXES: o globalsOf(..., recursive = TRUE) would result in "Error in match.fun(FUN) : node stack overflow" if one of the globals identified was a function that called itself recursively (either directly or indirectly). Version: 0.10.2 [2017-08-08] BUG FIXES: * walkAST() could produce error "Cannot walk expression. Unknown object type '...'" for objects of type 'environment'. Version: 0.10.1 [2017-07-01] BUG FIXES: * walkAST() could produce error "Cannot walk expression. Unknown object type '...'" for objects of type 'list', 'expression' and 'S4'. Version: 0.10.0 [2017-04-16] NEW FEATURES: * Globals that are part of a formula are now identified. * findGlobals(..., trace = TRUE) will now show low-level parse information as the abstract syntax tree (AST) is walked. SOFTWARE QUALITY: * Enabled more internal sanity checks. BUG FIXES: * walkAST() could produce error "Cannot walk expression. Unknown object type 'nnn'" for expressions of type 'builtin', 'closure' and 'special'. Version: 0.9.0 [2017-03-09] NEW FEATURES: * Added option 'globals.debug', which when TRUE enables debugging output. BUG FIXES: * globalsOf(..., recursive = TRUE) would in some cases scan an incorrect subset of already identified globals. * globalsOf(..., recursive = TRUE) failed to skip objects part of package namespaces that where defined via a local() statement. Version: 0.8.0 [2017-01-14] NEW FEATURES: * globalsOf() identifies also globals in locally defined functions. This can be disabled with argument recursive = FALSE. * findGlobals() now takes both closures (functions) and expressions. Version: 0.7.2 [2016-12-28] BUG FIXES: * c(x, list()) where x is a Globals object would give an error reporting that the list does not have named elements. Version: 0.7.1 [2016-10-13] NEW FEATURES: * Globals() and as.Globals() now accepts an empty list as input as well. BUG FIXES: * walkAST(quote( function(x=NULL) 0 )) would give a sanity check error due to the NULL argument. Thank you GitHub user billy34 for reporting on this. Version: 0.7.0 [2016-09-08] NEW FEATURES: * Added walkAST(), which can be used to tweak expressions. * Added globalsByName() for locating and retrieving a set of known global variables. * Added c(), $<-(), names(), unique() for Globals objects. * Improved as.Globals() for lists. Version: 0.6.1 [2016-01-31] NEW FEATURES: * Now the error message of globalsOf(..., mustExist=TRUE) when it fails to locate a global also gives information on the expression that is problematic. BUG FIXES: * cleanup() for Globals did not cleanup functions in core package environments named 'package:'. Version: 0.6.0 [2015-12-12] NEW FEATURES: * findGlobals() is updated to handle the case where a local variable is *verwriting a global one with the same name, e.g. { a <- b; b <- 1 }. Now 'b' is correctly identified as a global object. Previously it would have been missed. For backward compatibility, the previous behavior can be obtained using argument method="conservative". Version: 0.5.0 [2015-10-13] NEW FEATURES: * globalsOf() now returns attribute 'where' specifying where each global *bject is located. BUG FIXES: * cleanup() now only drops objects that are *located* in one of the "base" packages; previously it would also drop copies of such objects, e.g. FUN <- base::sample. Version: 0.4.1 [2015-10-05] BUG FIXES: * globalsOf() failed to return global variables with value NULL. They were identified but silently dropped. Version: 0.4.0 [2015-09-12] NEW FEATURES: * findGlobals() and globalsOf() gained argument 'dotdotdot'. Version: 0.3.1 [2015-06-10] * More test coverage. Version: 0.3.0 [2015-06-08] NEW FEATURES: * Renamed getGlobals() to globalsOf(). Version: 0.2.3 [2015-06-08] NEW FEATURES: * Added [() for Globals. * findGlobals() and getGlobals() gained argument 'substitute'. * Added cleanup(..., method="internals"). Version: 0.2.2 [2015-05-20] NEW FEATURES: * Added Globals class with methods cleanup() and packagesOf(). Added as.Globals() to coerce lists to Globals objects. Version: 0.2.1 [2015-05-20] NEW FEATURES: * getGlobals() gained argument 'mustExist' for controlling whether to give an error when the corresponding object for an identified global cannot be found or to silently drop the missing global. * findGlobals() and getGlobals() gained argument 'method' for controlling whether a "conservative" or a "liberal" algorithm for identifying true globals should be used. Version: 0.2.0 [2015-05-19] * Moved globals function from an in-house package to this package. Version: 0.1.0 [2015-02-07] * Created. globals/R/0000755000176200001440000000000013557174461012113 5ustar liggesusersglobals/R/utils.R0000644000176200001440000001352513557155442013402 0ustar liggesusersas_function <- function(expr, envir = parent.frame(), enclos = baseenv(), ...) { eval(substitute(function() x, list(x = expr)), envir = envir, enclos = enclos, ...) } # Although the set of "base" packages rarely changes, it has happened # in R's history. Beause of this, we avoid hardcoding the set of known # "base" packages and instead always look them up by the 'Priority' # field in their DESCRIPTION data and cache the results. #' @importFrom utils packageDescription is_base_pkg <- local({ cache <- list( R_EmptyEnv = FALSE, R_GlobalEnv = FALSE ) function(pkgs) { pkgs <- gsub("^package:", "", pkgs) npkgs <- length(pkgs) res <- rep(FALSE, times = npkgs) for (kk in seq_len(npkgs)) { pkg <- pkgs[kk] if (nzchar(pkg)) { value <- cache[[pkg]] if (is.null(value)) { prio <- suppressWarnings(packageDescription(pkg, fields = "Priority")) value <- (!is.na(prio) && prio == "base") cache[[pkg]] <<- value } } else { value <- FALSE } res[kk] <- value } res } }) # cf. is.primitive() is.base <- function(x) { if (typeof(x) != "closure") return(FALSE) is_base_pkg(environmentName(environment(x))) } # cf. is.primitive() is_internal <- function(x) { if (typeof(x) != "closure") return(FALSE) body <- deparse(body(x)) any(grepl(".Internal", body, fixed = TRUE)) } ## From R.utils 2.0.2 (2015-05-23) hpaste <- function(..., sep="", collapse=", ", last_collapse=NULL, max_head=if (missing(last_collapse)) 3 else Inf, max_tail=if (is.finite(max_head)) 1 else Inf, abbreviate="...") { max_head <- as.double(max_head) max_tail <- as.double(max_tail) if (is.null(last_collapse)) last_collapse <- collapse # Build vector 'x' x <- paste(..., sep = sep) n <- length(x) # Nothing todo? if (n == 0) return(x) if (is.null(collapse)) return(x) # Abbreviate? if (n > max_head + max_tail + 1) { head <- x[seq_len(max_head)] tail <- rev(rev(x)[seq_len(max_tail)]) x <- c(head, abbreviate, tail) n <- length(x) } if (!is.null(collapse) && n > 1) { if (last_collapse == collapse) { x <- paste(x, collapse = collapse) } else { x_head <- paste(x[1:(n - 1)], collapse = collapse) x <- paste(x_head, x[n], sep = last_collapse) } } x } ## From future 0.11.0 trim <- function(s) { sub("[\t\n\f\r ]+$", "", sub("^[\t\n\f\r ]+", "", s)) } # trim() ## From future 0.11.0 hexpr <- function(expr, trim = TRUE, collapse = "; ", max_head = 6L, max_tail = 3L, ...) { code <- deparse(expr) if (trim) code <- trim(code) hpaste(code, collapse = collapse, max_head = max_head, max_tail = max_tail, ...) } # hexpr() ## From future 1.3.0 mdebug <- function(...) { if (!getOption("globals.debug", FALSE)) return(invisible(FALSE)) message(sprintf(...)) invisible(TRUE) } ## mdebug() #' @importFrom utils capture.output str mstr <- function(...) { bfr <- capture.output(str(...)) bfr <- paste(bfr, collapse = "\n") message(bfr, appendLF = TRUE) } #' @importFrom utils capture.output envname <- function(env) { if (!is.environment(env)) return(NA_character_) name <- environmentName(env) if (name == "") { class <- class(env) if (identical(class, "environment")) { ## e.g. new.env() name <- capture.output(print(env)) } else { ## It might be that 'env' is on a class that extends 'environment', ## e.g. R.oo::Object() or R6::R6Class(). ## IMPORTANT: The unset class must be temporary, because changing ## the class of an environment will name <- local({ on.exit(class(env) <- class) class(env) <- NULL capture.output(print(env)) }) } name <- gsub("(.*: |>)", "", name) } else { ## e.g. globals:::where("plan") name <- gsub("package:", "", name, fixed = TRUE) } name } ## When 'default' is specified, this is 30x faster than ## base::getOption(). The difference is that here we use ## use names(.Options) whereas in 'base' names(options()) ## is used. getOption <- local({ go <- base::getOption function(x, default = NULL) { if (missing(default) || match(x, table = names(.Options), nomatch = 0L) > 0L) go(x) else default } }) stop_if_not <- function(...) { res <- list(...) n <- length(res) if (n == 0L) return() for (ii in 1L:n) { res_ii <- .subset2(res, ii) if (length(res_ii) != 1L || is.na(res_ii) || !res_ii) { mc <- match.call() call <- deparse(mc[[ii + 1]], width.cutoff = 60L) if (length(call) > 1L) call <- paste(call[1L], "...") stop(sQuote(call), " is not TRUE", call. = FALSE, domain = NA) } } } #' Gets the length of an object without dispatching #' #' @param x Any \R object. #' #' @return A non-negative integer. #' #' @details #' This function returns \code{length(unclass(x))}, but tries to avoid #' calling \code{unclass(x)} unless necessary. #' #' @seealso \code{\link{.subset}()} and \code{\link{.subset2}()}. #' #' @keywords internal #' @rdname private_length #' @importFrom utils getS3method .length <- function(x) { nx <- length(x) ## Can we trust base::length(x), i.e. is there a risk that there is ## a method that overrides with another definition? classes <- class(x) if (length(classes) == 1L && classes == "list") return(nx) ## Identify all length() methods for this object for (class in classes) { fun <- getS3method("length", class, optional = TRUE) if (!is.null(fun)) { nx <- length(unclass(x)) break } } nx } ## .length() ## An lapply(X) without internal X <- as.list(X), without setting names, ## and without dispatching using `[[`. list_apply <- function(X, FUN, ...) { n <- .length(X) res <- vector("list", length = n) for (kk in seq_len(n)) { res[[kk]] <- FUN(.subset2(X, kk), ...) } res } globals/R/zzz.R0000644000176200001440000000104413557155312013064 0ustar liggesusers## covr: skip=all .onLoad <- function(libname, pkgname) { ## Memoize: Already here, when the package is loaded, record whether ## some packages are 'base' packages or not. ## Packages that most likely are 'base' packages: pkgs <- c("base", "compiler", "datasets", "graphics", "grDevices", "grid", "methods", "parallel", "splines", "stats", "stats4", "tcltk", "tools", "utils") ## This package and other packags already loaded (incl. it's dependencies) pkgs <- c(pkgs, pkgname, loadedNamespaces()) is_base_pkg(pkgs) } globals/R/findGlobals.R0000644000176200001440000002763513557174461014477 0ustar liggesusers## This function is equivalent to: ## fun <- as_function(expr, envir = envir, ...) ## codetools::findGlobals(fun, merge = TRUE) ## but we expand it here to make it more explicit ## what is going on. #' @importFrom codetools makeUsageCollector findLocalsList walkCode find_globals_conservative <- function(expr, envir, ..., trace = FALSE) { objs <- character() enter <- function(type, v, e, w) { objs <<- c(objs, v) } if (is.function(expr)) { if (typeof(expr) != "closure") return(character(0L)) # e.g. `<-` fun <- expr w <- makeUsageCollector(fun, name = "", enterGlobal = enter) if (trace) w <- inject_tracer_to_walker(w) collect_usage_function(fun, name = "", w) } else { ## From codetools::findGlobals(): fun <- as_function(expr, envir = envir, ...) # codetools::collectUsage(fun, enterGlobal = enter) ## The latter becomes equivalent to (after cleanup): w <- makeUsageCollector(fun, name = "", enterGlobal = enter) w$env <- new.env(hash = TRUE, parent = w$env) if (trace) w <- inject_tracer_to_walker(w) locals <- findLocalsList(list(expr)) for (name in locals) assign(name, value = TRUE, envir = w$env) walkCode(expr, w) } unique(objs) } #' @importFrom codetools makeUsageCollector walkCode find_globals_liberal <- function(expr, envir, ..., trace = FALSE) { objs <- character() enter <- function(type, v, e, w) { objs <<- c(objs, v) } if (is.function(expr)) { if (typeof(expr) != "closure") return(character(0L)) ## e.g. `<-` fun <- expr w <- makeUsageCollector(fun, name = "", enterGlobal = enter) if (trace) w <- inject_tracer_to_walker(w) collect_usage_function(fun, name = "", w) } else { fun <- as_function(expr, envir = envir, ...) w <- makeUsageCollector(fun, name = "", enterGlobal = enter) if (trace) w <- inject_tracer_to_walker(w) walkCode(expr, w) } unique(objs) } #' @importFrom codetools makeUsageCollector walkCode find_globals_ordered <- function(expr, envir, ..., trace = FALSE) { selfassign <- getOption("globals.selfassign", TRUE) class <- name <- character() enter_local <- function(type, v, e, w) { ## LH <- RH: Handle cases where a global variable exists in RH and LH ## assigns a local variable with the same name, e.g. x <- x + 1. ## In such case we want to detect 'x' as a global variable. if (selfassign && (type == "<-" || type == "=")) { rhs <- e[[3]] globals <- all.names(rhs) if (length(rhs) == 3 && globals[1] %in% c("::", ":::")) { ## Case: a <- pkg::a } else if (v %in% globals) { class <<- c(class, "global") name <<- c(name, v) } } class <<- c(class, "local") name <<- c(name, v) } enter_global <- function(type, v, e, w) { class <<- c(class, "global") name <<- c(name, v) ## Also walk formulas to identify globals if (type == "function") { if (v == "~") { stop_if_not(identical(e[[1]], as.symbol("~"))) expr <- e[-1] for (kk in seq_along(expr)) { globals <- find_globals_ordered(expr = expr[[kk]], envir = w$env) if (length(globals) > 0) { class <<- c(class, rep("global", times = length(globals))) name <<- c(name, globals) } } } else if (selfassign && (v == "<-" || v == "=")) { ## LH <- RH: Handle cases where a global variable exists in LH in the ## form of x[1] <- 0, which will cause 'x' to be called a ## local variable later unless called global here. lhs <- e[[2]] if (length(lhs) >= 2) { ## Cases: a[1] <- 0, names(a) <- "x", names(a)[1] <- "x" ## Skip first symbol, because it'll be handled up later as ## an assignment function, e.g. `[<-` and `names<-` globals <- find_globals_ordered(expr = lhs, envir = w$env) if (length(globals) > 0) { class <<- c(class, rep("global", times = length(globals))) name <<- c(name, globals) } } } } } ## A function or an expression? if (is.function(expr)) { if (typeof(expr) != "closure") return(character(0L)) ## e.g. `<-` fun <- expr w <- makeUsageCollector(fun, name = "", enterLocal = enter_local, enterGlobal = enter_global) if (trace) w <- inject_tracer_to_walker(w) collect_usage_function(fun, name = "", w) } else { fun <- as_function(expr, envir = envir, ...) w <- makeUsageCollector(fun, name = "", enterLocal = enter_local, enterGlobal = enter_global) if (trace) w <- inject_tracer_to_walker(w) walkCode(expr, w) } ## Drop duplicated names dups <- duplicated(name) class <- class[!dups] name <- name[!dups] unique(name[class == "global"]) } #' @param dotdotdot TBD. #' #' @param trace TBD. #' #' @return \code{findGlobals()} returns a character vector. #' #' @rdname globalsOf #' @export findGlobals <- function(expr, envir = parent.frame(), ..., tweak = NULL, dotdotdot = c("warning", "error", "return", "ignore"), method = c("ordered", "conservative", "liberal"), substitute = FALSE, unlist = TRUE, trace = FALSE) { method <- match.arg(method, choices = c("ordered", "conservative", "liberal")) dotdotdot <- match.arg(dotdotdot, choices = c("warning", "error", "return", "ignore")) if (substitute) expr <- substitute(expr) debug <- mdebug("findGlobals(..., dotdotdot = '%s', method = '%s', unlist = %s) ...", dotdotdot, method, unlist) if (is.list(expr)) { debug && mdebug(" - expr: ", .length(expr)) ## NOTE: Do *not* look for types that we are interested in, but instead ## look for types that we are *not* interested. The reason for this that ## in future versions of R there might be new types added that may contain ## globals and with this approach those types will also be scanned. basicTypes <- c("logical", "integer", "double", "complex", "character", "raw", "NULL") ## Skip elements in 'expr' of basic types that cannot contain globals types <- unlist(list_apply(expr, FUN = typeof), use.names = FALSE) keep <- !(types %in% basicTypes) ## Don't use expr[keep] here, because that may use S3 dispatching ## depending on class(expr) expr <- .subset(expr, keep) ## Early stopping? if (.length(expr) == 0) { debug && mdebug(" - globals found: [0] ") debug && mdebug("findGlobals(..., dotdotdot = '%s', method = '%s', unlist = %s) ... DONE", dotdotdot, method, unlist) #nolint return(character(0L)) } globals <- list_apply(expr, FUN = findGlobals, envir = envir, ..., tweak = tweak, dotdotdot = dotdotdot, substitute = FALSE, unlist = FALSE) keep <- types <- NULL ## Not needed anymore debug && mdebug(" - preliminary globals found: [%d] %s", length(globals), hpaste(sQuote(names(globals)))) if (unlist) { needs_dotdotdot <- FALSE for (kk in seq_along(globals)) { s <- globals[[kk]] n <- length(s) if (identical(s[n], "...")) { needs_dotdotdot <- TRUE s <- s[-n] globals[[kk]] <- s } } globals <- unlist(globals, use.names = FALSE) if (length(globals) > 1L) globals <- unique(globals) if (needs_dotdotdot) globals <- c(globals, "...") } debug && mdebug(" - globals found: [%d] %s", length(globals), hpaste(sQuote(globals))) debug && mdebug("findGlobals(..., dotdotdot = '%s', method = '%s', unlist = %s) ... DONE", dotdotdot, method, unlist) #nolint return(globals) } if (is.function(tweak)) { debug && mdebug(" - tweaking expression using function") expr <- tweak(expr) } if (method == "ordered") { find_globals_t <- find_globals_ordered } else if (method == "conservative") { find_globals_t <- find_globals_conservative } else if (method == "liberal") { find_globals_t <- find_globals_liberal } ## Is there a need for global '...' variables? needs_dotdotdot <- FALSE globals <- withCallingHandlers({ oopts <- options(warn = 0L) on.exit(options(oopts)) find_globals_t(expr, envir = envir, trace = trace) }, warning = function(w) { ## Warned about '...'? ## NOTE: The warning we're looking for is the one generated by ## codetools::findGlobals(). That warning is _not_ translated, ## meaning this approach should work as is as long as the message ## is not modified by codetools itself. If codetools ever changes ## this such that the below string matching fails, then the package ## tests (tests/dotdotdot.R) will detect that. In other words, ## such a change will not go unnoticed. /HB 2017-03-08 pattern <- "... may be used in an incorrect context" if (grepl(pattern, w$message, fixed = TRUE)) { debug && mdebug(" - detected: %s", dQuote(trim(w$message))) needs_dotdotdot <<- TRUE if (dotdotdot == "return") { ## Consume / muffle warning invokeRestart("muffleWarning") } else if (dotdotdot == "ignore") { needs_dotdotdot <<- FALSE ## Consume / muffle warning invokeRestart("muffleWarning") } else if (dotdotdot == "error") { e <- simpleError(w$message, w$call) stop(e) } } }) if (needs_dotdotdot) globals <- c(globals, "...") debug && mdebug(" - globals found: [%d] %s", length(globals), hpaste(sQuote(globals))) debug && mdebug("findGlobals(..., dotdotdot = '%s', method = '%s', unlist = %s) ... DONE", dotdotdot, method, unlist) #nolint globals } ## Utility functions adopted from codetools:::dropMissing() ## and codetools:::collectUsageFun() drop_missing_formals <- function(x) { nx <- length(x) ix <- logical(length = nx) for (i in seq_len(nx)) { tmp <- x[[i]] if (!missing(tmp)) ix[i] <- TRUE } x[ix] } #' @importFrom codetools walkCode findLocalsList collect_usage_function <- function(fun, name, w) { formals <- formals(fun) body <- body(fun) w$name <- c(w$name, name) parnames <- names(formals) formals_clean <- drop_missing_formals(formals) # locals <- findLocalsList(c(list(body), formals_clean)) locals <- findLocalsList(formals_clean) w$env <- new.env(hash = TRUE, parent = w$env) for (n in c(parnames, locals)) assign(n, TRUE, w$env) for (a in formals_clean) walkCode(a, w) walkCode(body, w) } inject_tracer_to_function <- function(fcn, name) { b <- body(fcn) f <- formals(fcn) args <- setdiff(names(f), c("w", "...")) title <- sprintf("%s()", name) b <- bquote({ message(.(title), ":") if (length(.(args)) > 0) message(paste(utils::capture.output(utils::str(mget(.(args)))), collapse = "\n")) env <- environment(w$enterLocal) n <- length(env$name) value <- .(b) nnew <- (length(env$name) - n) if (nnew) { message(" ", .(title), " variables:") vars <- data.frame(name=env$name, class=env$class) vars$added <- c(rep(FALSE, times = n), rep(TRUE, times = nnew)) message(paste(utils::capture.output(print(vars)), collapse = "\n")) } message(" ", .(title) , " => ", utils::capture.output(utils::str(value))) value }) body(fcn) <- b fcn } inject_tracer_to_walker <- function(w) { if (is.null(w$startCollectLocals)) { w$startCollectLocals <- function(parnames, locals, ...) { NULL } } if (is.null(w$finishCollectLocals)) { w$finishCollectLocals <- function(w, ...) { NULL } } if (is.null(w$enterInternal)) { w$enterInternal <- function(type, v, e, ...) { NULL } } for (key in names(w)) { fcn <- w[[key]] if (!is.function(fcn)) next fcn <- inject_tracer_to_function(fcn, key) w[[key]] <- fcn } w } globals/R/packagesOf.R0000644000176200001440000000165613557155442014307 0ustar liggesusers#' @export packagesOf <- function(...) UseMethod("packagesOf") #' Identify the packages of the globals #' #' @param globals A Globals object. #' @param \dots Not used. #' #' @return Returns a character vector of package names. #' #' @aliases packagesOf #' @export 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)) }, FUN.VALUE = "", USE.NAMES = FALSE) ## Drop "missing" packages, e.g. globals in globalenv(). pkgs <- pkgs[nzchar(pkgs)] ## Drop global environment pkgs <- pkgs[pkgs != "R_GlobalEnv"] ## Keep only names matching loaded namespaces pkgs <- intersect(pkgs, loadedNamespaces()) ## Packages to be loaded pkgs <- unique(pkgs) ## Sanity check stop_if_not(all(nzchar(pkgs))) pkgs } # packagesOf() globals/R/walkAST.R0000644000176200001440000000701413557155312013540 0ustar liggesusers#' Walk the Abstract Syntax Tree (AST) of an R Expression #' #' @param expr R \link[base]{expression}. #' @param atomic,name,call,pairlist single-argument function that takes an #' atomic, name, call and pairlist expression, respectively. Have to #' return a valid R expression. #' @param name single-argument function that takes a name expression. #' @param call single-argument function that takes a call expression. #' @param pairlist single-argument function that takes a pairlist expression. #' @param substitute If TRUE, \code{expr} is #' \code{\link[base]{substitute}()}:ed. #' #' @return R \link[base]{expression}. #' #' @export #' @keywords programming internal walkAST <- function(expr, atomic = NULL, name = NULL, call = NULL, pairlist = NULL, substitute = FALSE) { if (substitute) expr <- substitute(expr) if (is.atomic(expr)) { if (is.function(atomic)) expr <- atomic(expr) } else if (is.name(expr)) { if (is.function(name)) expr <- name(expr) } else if (is.call(expr)) { ## message("call") for (cc in seq_along(expr)) { ## AD HOC: The following is needed to handle x[, 1]. /HB 2016-09-06 if (is.name(expr[[cc]]) && expr[[cc]] == "") next e <- walkAST(expr[[cc]], atomic = atomic, name = name, call = call, pairlist = pairlist, substitute = FALSE) if (is.null(e)) { expr[cc] <- list(NULL) } else { expr[[cc]] <- e } } if (is.function(call)) expr <- call(expr) } else if (is.pairlist(expr)) { ## message("pairlist") for (pp in seq_along(expr)) { ## AD HOC: The following is needed to handle '...'. /HB 2016-09-06 if (is.name(expr[[pp]]) && expr[[pp]] == "") next e <- walkAST(expr[[pp]], atomic = atomic, name = name, call = call, pairlist = pairlist, substitute = FALSE) if (is.null(e)) { expr[pp] <- list(NULL) } else { expr[[pp]] <- e } } ## WORKAROUND: Since expr[i] <- list(NULL) turns pairlist 'expr' into ## a list we have to make sure to it is a pairlist also afterward, cf. ## https://stat.ethz.ch/pipermail/r-devel/2016-October/073263.html ## /HB 2016-10-12 expr <- as.pairlist(expr) } else if (is.list(expr)) { ## FIXME: Should we have a specific function for this, or is atomic() ok? ## https://github.com/HenrikBengtsson/globals/issues/27 if (is.function(atomic)) expr <- atomic(expr) } else if (typeof(expr) %in% c("builtin", "closure", "special", "expression", "S4", "environment")) { ## Nothing to do ## FIXME: ... or can closures and specials be "walked"? /HB 2017-03-21 ## FIXME: Should "promise", "char", "...", "any", "externalptr", ## "bytecode", and "weakref" (cf. ?typeof) also be added? /2017-07-01 return(expr) } else { msg <- paste("Cannot walk expression. Unknown object type", sQuote(typeof(expr))) onUnknownType <- getOption("globals.walkAST.onUnknownType", "error") if (onUnknownType == "error") { stop(msg, call. = FALSE) } else if (onUnknownType == "warning") { warning(msg, call. = FALSE) } ## Skip below assertion return(expr) } ## Assert that the tweak functions return a valid object if (!missing(expr)) { stop_if_not(is.atomic(expr) || is.list(expr) || is.name(expr) || is.call(expr) || is.pairlist(expr) || typeof(expr) %in% c("builtin", "closure", "special")) } expr } ## walkAST() globals/R/cleanup.R0000644000176200001440000000240713557155312013662 0ustar liggesusers#' @export cleanup <- function(...) UseMethod("cleanup") #' Drop certain types of globals #' #' @param globals A Globals object. #' @param drop A character vector specifying what type of globals to drop. #' @param \dots Not used #' #' @aliases cleanup #' @export cleanup.Globals <- function(globals, drop = c("missing", "base-packages"), ...) { where <- attr(globals, "where", exact = TRUE) names <- names(globals) keep <- rep(TRUE, times = length(globals)) names(keep) <- names ## Drop non-found objects if ("missing" %in% drop) { for (name in names) { if (is.null(where[[name]])) keep[name] <- FALSE } } ## Drop objects that are part of one of the "base" packages if ("base-packages" %in% drop) { for (name in names) { if (is_base_pkg(environmentName(where[[name]]))) keep[name] <- FALSE } } ## Drop objects that are primitive functions if ("primitives" %in% drop) { for (name in names) { if (is.primitive(globals[[name]])) keep[name] <- FALSE } } ## Drop objects that calls .Internal() if ("internals" %in% drop) { for (name in names) { if (is_internal(globals[[name]])) keep[name] <- FALSE } } if (!all(keep)) { globals <- globals[keep] } globals } globals/R/globalsOf.R0000644000176200001440000002210413557155442014143 0ustar liggesusers#' Get all global objects of an expression #' #' @param expr An R expression. #' #' @param envir The environment from where to search for globals. #' #' @param \dots Not used. #' #' @param method A character string specifying what type of search algorithm #' to use. #' #' @param tweak An optional function that takes an expression #' and returns a tweaked expression. #' #' @param substitute If TRUE, the expression is \code{substitute()}:ed, #' otherwise not. #' #' @param mustExist If TRUE, an error is thrown if the object of the #' identified global cannot be located. Otherwise, the global #' is not returned. #' #' @param unlist If TRUE, a list of unique objects is returned. #' If FALSE, a list of \code{length(expr)} sublists. #' #' @param recursive If TRUE, globals that are closures (functions) and that #' exist outside of namespaces ("packages"), will be recursively #' scanned for globals. #' #' @param skip (internal) A list of globals not to be searched for #' additional globals. Ignored unless \code{recursive} is TRUE. #' #' @return \code{globalsOf()} returns a \link{Globals} object. #' #' @details #' There currently three strategies for identifying global objects. #' #' The \code{method = "ordered"} search method identifies globals such that #' a global variable preceding a local variable with the same name #' is not dropped (which the \code{"conservative"} method would). #' #' The \code{method = "conservative"} search method tries to keep the number #' of false positive to a minimum, i.e. the identified objects are #' most likely true global objects. At the same time, there is #' a risk that some true globals are not identified (see example). #' This search method returns the exact same result as the #' \code{\link[codetools]{findGlobals}()} function of the #' \pkg{codetools} package. #' #' The \code{method = "liberal"} search method tries to keep the #' true-positive ratio as high as possible, i.e. the true globals #' are most likely among the identified ones. At the same time, #' there is a risk that some false positives are also identified. #' #' With \code{recursive = TRUE}, globals part of locally defined #' functions will also be found, otherwise not. #' #' @example incl/globalsOf.R #' #' @seealso #' Internally, the \pkg{\link{codetools}} package is utilized for #' code inspections. #' #' @aliases findGlobals #' @export globalsOf <- function(expr, envir = parent.frame(), ..., method = c("ordered", "conservative", "liberal"), tweak = NULL, substitute = FALSE, mustExist = TRUE, unlist = TRUE, recursive = TRUE, skip = NULL) { method <- match.arg(method, choices = c("ordered", "conservative", "liberal")) if (substitute) expr <- substitute(expr) stop_if_not(is.null(skip) || is.list(skip)) debug <- mdebug("globalsOf(..., method = '%s', mustExist = %s, unlist = %s, recursive = %s) ...", method, mustExist, unlist, recursive) #nolint ## 1. Identify global variables (static code inspection) names <- findGlobals(expr, envir = envir, ..., method = method, tweak = tweak, substitute = FALSE, unlist = unlist) debug && mdebug(" - preliminary globals (by name): [%d] %s", length(names), hpaste(sQuote(names))) ## 2. Locate them (run time) globals <- tryCatch({ globalsByName(names, envir = envir, mustExist = mustExist) }, error = function(ex) { ## HACK: Tweak error message to also include the expression inspected. msg <- conditionMessage(ex) msg <- sprintf("Identified global objects via static code inspection (%s). %s", hexpr(expr), msg) #nolint ex$message <- msg stop(ex) }) debug && mdebug(" - preliminary globals (by value): [%d] %s", length(globals), hpaste(sQuote(names(globals)))) ## 3. Among globals that are closures (functions) and that exist outside ## of namespaces ("packages"), check for additional globals? if (recursive) { debug && mdebug(" - recursive scan of preliminary globals ...") ## Don't enter functions in namespaces / packages where <- attr(globals, "where", exact = TRUE) stop_if_not(length(where) == length(globals)) where <- vapply(where, FUN = envname, FUN.VALUE = NA_character_, USE.NAMES = FALSE) globals_t <- globals[!(where %in% loadedNamespaces())] debug && mdebug(" - subset of globals to be scanned (not in loaded namespaces): [%d] %s", length(globals_t), hpaste(sQuote(names(globals_t)))) #nolint ## Enter only functions ## NOTE: This excludes functions "not found", but also primitives ## not dropped above. globals_t <- globals_t[vapply(globals_t, FUN = typeof, FUN.VALUE = NA_character_, USE.NAMES = FALSE) == "closure"] if (length(globals_t) > 0) { debug && mdebug(" - subset of globals to be scanned: [%d] %s", length(globals_t), hpaste(sQuote(names(globals_t)))) names_t <- names(globals_t) ## Avoid recursive scanning of already scanned ("known") globals skip_t <- c(skip, globals_t) for (gg in seq_along(globals_t)) { debug && mdebug(" + scanning global #%d (%s) ...", gg, sQuote(names_t[[gg]])) fcn <- globals_t[[gg]] ## Is function 'fcn' among the already identified globals? already_scanned <- any(vapply(skip, FUN = identical, fcn, FUN.VALUE = NA, USE.NAMES = FALSE)) if (already_scanned) next; env <- environment(fcn) ## was 'env <- envir' in globals 0.8.0. globals_gg <- globalsOf(fcn, envir = env, ..., method = method, tweak = tweak, substitute = FALSE, mustExist = mustExist, unlist = unlist, recursive = recursive, skip = skip_t) if (length(globals_gg) > 0) { globals <- c(globals, globals_gg) skip_gg <- globals_gg[vapply(globals_gg, FUN = typeof, FUN.VALUE = NA_character_, USE.NAMES = FALSE) == "closure"] skip_t <- c(skip_t, skip_gg) } } globals <- unique(globals) debug && mdebug(" - updated set of globals found: [%d] %s", length(globals), hpaste(sQuote(names(globals)))) } else { debug && mdebug(" - subset of globals to be scanned: [0]") } debug && mdebug(" - recursive scan of preliminary globals ... DONE") } debug && mdebug(" - globals found: [%d] %s", length(globals), hpaste(sQuote(names(globals)))) debug && mdebug("globalsOf(..., method = '%s', mustExist = %s, unlist = %s, recursive = %s) ... DONE", method, mustExist, unlist, recursive) #nolint globals } ## globalsOf() #' Locates and retrieves a set of global variables by their names #' #' @param names A character vector of global variable names. #' @param envir The environment from where to search for globals. #' @param mustExist If TRUE, an error is thrown if the object of the #' identified global cannot be located. Otherwise, the global #' is not returned. #' @param ... Not used. #' #' @return A \link{Globals} object. #' #' @export globalsByName <- function(names, envir = parent.frame(), mustExist = TRUE, ...) { names <- as.character(names) nnames <- length(names) debug <- mdebug("globalsByName(<%d names>, mustExist = %s) ...", nnames, mustExist) debug && mdebug("- search from environment: %s", sQuote(envname(envir))) ## Locate and retrieve the specified globals idxs <- which(names == "...") needs_dotdotdot <- (length(idxs) > 0) if (needs_dotdotdot) names <- names[-idxs] debug && mdebug("- dotdotdot: %s", needs_dotdotdot) globals <- structure(list(), class = c("Globals", "list")) where <- list() for (kk in seq_along(names)) { name <- names[kk] debug && mdebug("- locating #%d (%s)", kk, sQuote(name)) env <- where(name, envir = envir, inherits = TRUE) debug && mdebug(" + found in environment: %s", sQuote(envname(env))) if (!is.null(env)) { where[[name]] <- env value <- get(name, envir = env, inherits = FALSE) if (is.null(value)) { globals[name] <- list(NULL) } else { globals[[name]] <- value } } else { globals[name] <- list(NULL) where[name] <- list(NULL) if (mustExist) { stop(sprintf("Failed to locate global object in the relevant environments: %s", sQuote(name))) #nolint } } } if (needs_dotdotdot) { if (exists("...", envir = envir, inherits = TRUE)) { where[["..."]] <- where("...", envir = envir, inherits = TRUE) ddd <- evalq(list(...), envir = envir, enclos = envir) } else { where["..."] <- list(NULL) ddd <- NA } class(ddd) <- c("DotDotDotList", class(ddd)) globals[["..."]] <- ddd } stop_if_not( is.list(where), length(where) == length(globals), all(names(where) == names(globals)) ) attr(globals, "where") <- where debug && mdebug("globalsByName(<%d names>, mustExist = %s) ... DONE", nnames, mustExist) globals } ## globalsByName() globals/R/where.R0000644000176200001440000000346013557155442013351 0ustar liggesusers## Emulates R internal findVar1mode() function ## https://svn.r-project.org/R/trunk/src/main/envir.c where <- function(x, where = -1, envir = if (missing(frame)) { if (where < 0) parent.frame(-where) else as.environment(where) } else sys.frame(frame), frame, mode = "any", inherits = TRUE) { ## Validate arguments stop_if_not(is.environment(envir)) stop_if_not(is.character(mode), length(mode) == 1L) inherits <- as.logical(inherits) stop_if_not(inherits %in% c(FALSE, TRUE)) debug <- mdebug("where(%s, where = %d, envir = %s, mode = %s, inherits = %s) ...", sQuote(x), where, sQuote(envname(envir)), sQuote(mode), inherits) ## Search env <- envir while (!identical(env, emptyenv())) { debug && mdebug("- searching %s: %s", sQuote(envname(env)), hpaste(sQuote(ls(envir = env, all.names = TRUE)))) if (exists(x, envir = env, mode = mode, inherits = FALSE)) { debug && mdebug(" + found in location: %s", sQuote(envname(env))) debug && mdebug("where(%s, where = %d, envir = %s, mode = %s, inherits = %s) ... DONE", sQuote(x), where, sQuote(envname(envir)), sQuote(mode), inherits) #nolint return(env) } if (!inherits) { debug && mdebug(" + failed to locate: NULL") debug && mdebug("where(%s, where = %d, envir = %s, mode = %s, inherits = %s) ... DONE", sQuote(x), where, sQuote(envname(envir)), sQuote(mode), inherits) #nolint return(NULL) } env <- parent.env(env) } debug && mdebug("- failed to locate: NULL") debug && mdebug("where(%s, where = %d, envir = %s, mode = %s, inherits = %s) ... DONE", sQuote(x), where, sQuote(envname(envir)), sQuote(mode), inherits) NULL } globals/R/Globals-class.R0000644000176200001440000001040613557155312014717 0ustar liggesusers#' A representation of a set of globals #' #' @usage Globals(object, ...) #' #' @param object A named list. #' @param \dots Not used. #' #' @return An object of class \code{Future}. #' #' @seealso #' The \code{\link{globalsOf}()} function identifies globals #' from an R expression and returns a Globals object. #' #' @aliases as.Globals as.Globals.Globals as.Globals.list [.Globals names #' @export Globals <- function(object = list(), ...) { if (!is.list(object)) { stop("Argument 'object' is not a list: ", class(object)[1]) } if (length(object) > 0) { names <- names(object) if (is.null(names)) { stop("Argument 'object' must be a named list.") } else if (!all(nzchar(names))) { stop("Argument 'object' specifies globals with empty names.") } } where <- attr(object, "where", exact = TRUE) if (length(object) == 0 && is.null(where)) { attr(object, "where") <- where <- list() } stop_if_not(is.list(where)) stop_if_not( is.list(where), length(where) == length(object), length(names(where)) == length(names(object)) ) structure(object, class = c("Globals", class(object))) } #' @export as.Globals <- function(x, ...) UseMethod("as.Globals") #' @export as.Globals.Globals <- function(x, ...) x #' @export as.Globals.list <- function(x, ...) { ## Use the globals environments as the locals? ## (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 }) names(where) <- names(x) attr(x, "where") <- where } Globals(x, ...) } #' @export `names<-.Globals` <- function(x, value) { x <- NextMethod() where <- attr(x, "where", exact = TRUE) names(where) <- names(x) attr(x, "where") <- where invisible(x) } #' @export `[.Globals` <- function(x, i) { where <- attr(x, "where", exact = TRUE) res <- NextMethod() attr(res, "where") <- where[i] class(res) <- class(x) where <- attr(res, "where", exact = TRUE) stop_if_not( is.list(where), length(where) == length(res), length(names(where)) == length(names(res)) ) res } #' @export `$<-.Globals` <- function(x, name, value) { where <- attr(x, "where", exact = TRUE) ## Remove an element? if (is.null(value)) { x[[name]] <- NULL where[[name]] <- NULL } else { ## Value must be Globals object of length one if (inherits(value, "Globals")) { if (length(value) != 1) { stop("Cannot assign Globals object of length different than one: ", length(value)) } 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 } } attr(x, "where") <- where invisible(x) } #' @export c.Globals <- function(x, ...) { args <- list(...) where <- attr(x, "where", exact = TRUE) clazz <- class(x) class(x) <- NULL for (kk in seq_along(args)) { g <- args[[kk]] name <- names(args)[kk] if (inherits(g, "Globals")) { w <- attr(g, "where", exact = TRUE) } else if (is.list(g)) { ## Nothing to do? if (length(g) == 0) next 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 }) names(w) <- names } else { if (is.null(name)) { stop("Can only append named objects to Globals list: ", sQuote(mode(g))) } g <- structure(list(g), names = name) e <- environment(g) if (is.null(e)) e <- emptyenv() w <- structure(list(e), names = name) } where <- c(where, w) x <- c(x, g) } class(x) <- clazz attr(x, "where") <- where stop_if_not( length(where) == length(x), all(names(where) == names(x)) ) x } #' @export unique.Globals <- function(x, ...) { names <- names(x) dups <- duplicated(names) if (any(dups)) { where <- attr(x, "where", exact = TRUE) where <- where[!dups] x <- x[!dups] attr(x, "where") <- where stop_if_not( length(where) == length(x), all(names(where) == names(x)) ) } x } globals/MD50000644000176200001440000000334113573012452012210 0ustar liggesusers1e50c9cdc38a091ad82b9308ffe05549 *DESCRIPTION f970927a5b8b055c0645488e58362a8d *NAMESPACE c0b9ed6ac047499eb2ff34f680403e94 *NEWS f9352d37cfd133fc12bca7b5165675cf *R/Globals-class.R 6c0d5d7963928449cad8738bae047e8a *R/cleanup.R 22d2a35c41674a57b160c09e6ef71628 *R/findGlobals.R acdc94d7246b61e2a93dc330d8509331 *R/globalsOf.R a809c2d87122ac1e7f1132e0c6a03428 *R/packagesOf.R bff4fd5513917d2d17fa5f9951690904 *R/utils.R ee09ba3da4cc0e4d2c9c96835953aad2 *R/walkAST.R 5377d3f92fe155b5af0bb80fed72a1ab *R/where.R 6c105aa7e1191c6f71b3c39dcd71df6c *R/zzz.R 3544dd5b9f0ac95f763a213ed4142ceb *inst/WORDLIST abec206d57e9f3f4d34bb4a875d35490 *man/Globals.Rd 978342cde4007f1977a2a355dabf6ffa *man/cleanup.Globals.Rd fc7000ee5990508042e8b53ede23dae1 *man/globalsByName.Rd 8f90601468e6b902b719859ed682466e *man/globalsOf.Rd 71d33dd463fd36bf678fcf037e0d62aa *man/packagesOf.Globals.Rd 8f535a3461ee9bf48f75947b66fa71d9 *man/private_length.Rd ee2b14c67dbce787ab9b683a2c820b23 *man/walkAST.Rd 7cd7521a621a4963c0cee095dc890a14 *tests/Globals.R 4e14f10dce37601443615ffb1963c470 *tests/conservative.R dc142b97ff32d9d2ddc36e3dd003d22d *tests/dotdotdot.R f1793f869d4b2b473e2516e0e429bb8b *tests/findGlobals.R 6f1877fd08c8d2c7e731f69a35f5f9a1 *tests/formulas.R de77337d9770e5337bd1c5aab09b65f5 *tests/globalsByName.R af015dd0997050358072cd4ebf09fdca *tests/globalsOf.R de96a98bbdd939c26009df32797ffa39 *tests/incl/end.R 72f2efc875c454dbf03b0fd40ff18256 *tests/incl/globals.R c7740b7f891890f7103006f2a64b37f0 *tests/incl/start,load-only.R f178ec5ea5fda0b908700cc54550bf66 *tests/incl/start.R 344290e5ff01b892969ffaf91d20fc14 *tests/liberal.R 11adb2bf62fcd758126a87944d1a87cd *tests/utils.R 4d6835d9ab2dd497461bdb1aa2cb93d0 *tests/walkAST.R 7af53138f87e6ef0f9333c9b8176c51d *tests/zzz.R globals/inst/0000755000176200001440000000000013557155312012661 5ustar liggesusersglobals/inst/WORDLIST0000644000176200001440000000000413557155312014045 0ustar liggesusersAST