resolve regression in dependencies performance

.gitignore

@@ -16,5 +16,6 @@ revdep
 inst/doc
 renv/cellar
 
+/*.Rprof
 /*.tar.gz
 /*.backup

DESCRIPTION

@@ -18,8 +18,8 @@ URL: https://rstudio.github.io/renv/, https://github.com/rstudio/renv
 BugReports: https://github.com/rstudio/renv/issues
 Imports: utils
 Suggests: BiocManager, cli, covr, cpp11, devtools, gitcreds, jsonlite, jsonvalidate, knitr,
-    miniUI, packrat, pak, R6, remotes, reticulate, rmarkdown, rstudioapi, shiny, testthat,
-    uuid, waldo, yaml, webfakes
+    miniUI, modules, packrat, pak, R6, remotes, reticulate, rmarkdown, rstudioapi, shiny,
+    testthat, uuid, waldo, yaml, webfakes
 Encoding: UTF-8
 RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)

NEWS.md

@@ -1,6 +1,8 @@
 
 # renv (development version)
 
+* Fixed a performance regression in `renv::dependencies()`. (#1999)
+
 * Fixed an issue where `renv` tests could fail if the `parallel` package was
   loaded during test execution.
 

R/aaa.R

@@ -1,6 +1,7 @@
 
 # global variables
 the <- new.env(parent = emptyenv())
+the$paths <- new.env(parent = emptyenv())
 
 # detect if we're running on CI
 ci <- function() {

R/call.R

@@ -1,49 +1,35 @@
 
 # given a call of the form e.g. 'pkg::foo()' or 'foo()',
 # check that method 'foo()' is truly being called and
-# strip off the 'pkg::' part for easier parsing
+# strip off the 'pkg::' part for easier parsing.
+#
+# this gets called very often when parsing dependencies,
+# so optimizations are welcome here
 renv_call_expect <- function(node, package, methods) {
 
-  if (!is.call(node))
-    return(NULL)
-
+  result <- NULL
+
   # check for call of the form 'pkg::foo(a, b, c)'
-  colon <- renv_call_matches(
-    call  = node[[1L]],
-    name  = c("::", ":::"),
-    nargs = 2L
-  )
-
-  if (colon) {
-
-    # validate the package name
-    lhs <- node[[1L]][[2L]]
-    if (as.character(lhs) != package)
-      return(NULL)
-
-    # extract the inner call
-    rhs <- node[[1L]][[3L]]
-    node[[1L]] <- rhs
-  }
-
-  # check for method match
-  match <-
-    is.name(node[[1L]]) &&
-    as.character(node[[1L]]) %in% methods
-
-  if (!match)
-    return(NULL)
-
-  node
+  if (is.call(callnode <- node[[1L]]))
+    if (is.symbol(sym <- callnode[[1L]]))
+      if (sym == renv_syms_ns_get || sym == renv_syms_ns_get_int)
+        if (callnode[[2L]] == substitute(package))
+          node[[1L]] <- callnode[[3L]]
+
+  # check for any method match
+  if (is.symbol(sym <- node[[1L]]))
+    if (any(sym == methods))
+      result <- node
+
+  result
 
 }
 
-renv_call_normalize <- function(node, stack) {
+renv_call_normalize <- function(node) {
 
   # check for magrittr pipe -- if this part of the expression is
   # being piped into, then we need to munge the call
-  ispipe <- renv_call_matches(node, name = c("%>%", "%T>%", "%<>%"))
-
+  ispipe <- renv_call_matches(node, names = c("%>%", "%T>%", "%<>%"))
   if (!ispipe)
     return(node)
 
@@ -76,24 +62,15 @@ renv_call_normalize <- function(node, stack) {
 }
 
 
-renv_call_matches <- function(call, name = NULL, nargs = NULL) {
-
-  if (!is.call(call))
-    return(FALSE)
-
-  if (!is.null(name)) {
-
-    if (!is.name(call[[1]]))
-      return(FALSE)
-
-    if (!as.character(call[[1]]) %in% name)
-      return(FALSE)
-
-  }
-
-  if (!is.null(nargs) && length(call) != nargs + 1L)
-    return(FALSE)
-
-  TRUE
+renv_call_matches <- function(call, names, nargs = NULL) {
 
+  ok <- FALSE
+
+  if (is.call(call) &&
+      is.symbol(sym <- call[[1L]]) &&
+      any(names == as.character(sym)))
+    ok <- is.null(nargs) || length(call) == nargs + 1L
+
+  ok
+
 }

R/cli.R

@@ -45,7 +45,7 @@ renv_cli_exec_impl <- function(clargs) {
     return(renv_cli_unknown(method, exports))
 
   # begin building call
-  args <- list(call("::", as.name("renv"), as.name(method)))
+  args <- list(call("::", as.symbol("renv"), as.symbol(method)))
 
   for (clarg in clargs[-1L]) {
 

R/config.R

@@ -102,7 +102,7 @@ renv_config_get <- function(name,
     return(renv_config_validate(name, optval, type, default, args))
 
   # check for environment variable
-  envname <- gsub(".", "_", toupper(name), fixed = TRUE)
+  envname <- chartr(".", "_", toupper(name))
   envkey <- paste("RENV", toupper(scope), envname, sep = "_")
   envval <- Sys.getenv(envkey, unset = NA)
   if (!is.na(envval) && nzchar(envval)) {