N.env.parent arg

Author: tdhock

NEWS

@@ -1,6 +1,7 @@
 Changes in version 2024.10.3
 
 - atime_pkg generates files such as _test_name_.png with underscores instead of special characters such as > which are not supported on some file systems, including github actions (https://github.com/tdhock/atime/issues/62).
+- atime and atime_versions gain N.env.parent arg, which is set by atime_pkg to environment created for evaluation of atime/tests.R code. N.env.parent is the parent env of N.env, the environment in which code is run for a given data size N. So now setup in tests can refer to variables defined in atime/tests.R.
 
 Changes in version 2024.9.27
 

R/atime.R

@@ -86,9 +86,12 @@ default_N <- function(){
   as.integer(2^seq(1, 20))
 }
 
-atime <- function(N=default_N(), setup, expr.list=NULL, times=10, seconds.limit=0.01, verbose=FALSE, result=FALSE, ...){
+atime <- function(N=default_N(), setup, expr.list=NULL, times=10, seconds.limit=0.01, verbose=FALSE, result=FALSE, N.env.parent=NULL, ...){
   kilobytes <- mem_alloc <- . <- sizes <- NULL
   ## above for CRAN NOTE.
+  if(is.null(N.env.parent)){
+    N.env.parent <- parent.frame()
+  }
   if(!is.numeric(N)){
     stop("N should be a numeric vector")
   }
@@ -116,7 +119,7 @@ atime <- function(N=default_N(), setup, expr.list=NULL, times=10, seconds.limit=
   for(N.value in N){
     not.done.yet <- names(done.vec)[!done.vec]
     if(length(not.done.yet)){
-      N.env <- new.env(parent=parent.frame())
+      N.env <- new.env(parent=N.env.parent)
       N.env$N <- N.value
       eval(mc.args$setup, N.env)
       m.list <- list(quote(bench::mark), iterations=times,check=FALSE)

R/test.R

@@ -253,10 +253,11 @@ atime_pkg_test_info <- function(pkg.path=".", tests.dir=NULL){
     names(test.env$version.colors) %in% names(abbrev2name),
     abbrev2name[names(test.env$version.colors)],
     names(test.env$version.colors))
-  pkg.sha.args <- list(
+  common.args <- list(
+    N.env.parent=test.env,
     pkg.path=pkg.path,
     sha.vec=sha.vec)
-  test.env$test.list <- inherit_args(test.env$test.list, pkg.sha.args)
+  test.env$test.list <- inherit_args(test.env$test.list, common.args)
   test.env$test.call <- list()
   for(Test in names(test.env$test.list)){
     test.env$test.call[[Test]] <- as.call(c(
@@ -266,19 +267,29 @@ atime_pkg_test_info <- function(pkg.path=".", tests.dir=NULL){
   test.env
 }
 
-atime_test <- function(...){
-  as.list(match.call()[-1])
-}
-
-atime_test_list <- function(..., N, setup, expr, times, seconds.limit, verbose, pkg.edit.fun, result, tests=NULL){
-  could.copy <- intersect(names(formals(atime_versions)),names(formals()))
-  mc <- as.list(match.call()[-1])
+get_test_args <- function(){
+  s.parent <- sys.parent()
+  pfun <- sys.function(s.parent)
+  two.funs <- list(pfun, atime_versions)
+  name.vecs <- lapply(two.funs, function(f)names(formals(f)))
+  could.copy <- Reduce(intersect, name.vecs)
+  mc <- as.list(match.call(pfun, sys.call(s.parent))[-1])
   common.names <- intersect(names(mc), could.copy)
   possible.uneval <- c("setup","expr")
   uneval.names <- intersect(common.names, possible.uneval)
   eval.names <- setdiff(common.names, possible.uneval)
-  common.args <- mget(eval.names)
-  common.args[uneval.names] <- mc[uneval.names]
+  p.frame <- parent.frame()
+  test.args <- mget(eval.names, p.frame)
+  test.args[uneval.names] <- mc[uneval.names]
+  test.args
+}
+
+atime_test <- function(N, setup, expr, times, seconds.limit, verbose, pkg.edit.fun, result){
+  get_test_args()
+}
+
+atime_test_list <- function(..., N, setup, expr, times, seconds.limit, verbose, pkg.edit.fun, result, tests=NULL){
+  common.args <- get_test_args()
   L <- c(tests, list(...))
   inherit_args(L, common.args)
 }

R/versions.R

@@ -121,14 +121,14 @@ atime_versions_install <- function(Package, pkg.path, new.Package.vec, sha.vec,
   }#any to install
 }
 
-atime_versions <- function(pkg.path, N=default_N(), setup, expr, sha.vec=NULL, times=10, seconds.limit=0.01, verbose=FALSE, pkg.edit.fun=pkg.edit.default, result=FALSE, ...){
+atime_versions <- function(pkg.path, N=default_N(), setup, expr, sha.vec=NULL, times=10, seconds.limit=0.01, verbose=FALSE, pkg.edit.fun=pkg.edit.default, result=FALSE, N.env.parent=NULL, ...){
   ver.args <- list(
     pkg.path, substitute(expr), sha.vec, verbose, pkg.edit.fun, ...)
   install.seconds <- system.time({
     ver.exprs <- do.call(atime_versions_exprs, ver.args)
   })[["elapsed"]]
   a.args <- list(
-    N, substitute(setup), ver.exprs, times, seconds.limit, verbose, result)
+    N, substitute(setup), ver.exprs, times, seconds.limit, verbose, result, N.env.parent)
   bench.seconds <- system.time({
     out.list <- do.call(atime, a.args)
   })[["elapsed"]]

inst/example_tests.R

@@ -31,9 +31,11 @@ edit.data.table <- function(old.Package, new.Package, sha, new.pkg.path){
     sprintf('useDynLib\\("?%s"?', Package_regex),
     paste0('useDynLib(', new.Package_))
 }
+gvar <- 5
 test.list <- atime::atime_test_list(
   pkg.edit.fun=edit.data.table,
-  N=9,
-  test_N_expr=atime::atime_test(N=2, expr=rnorm(N)),
-  test_expr=atime::atime_test(expr=rnorm(N))
+  N=c(9,90),
+  test_N_expr=atime::atime_test(N=c(2,20), expr=rnorm(N)),
+  test_expr=atime::atime_test(expr=rnorm(N)),
+  global_var_in_setup=atime::atime_test(setup=rnorm(gvar), expr=atime:::.packageName)
 )

man/atime.Rd

@@ -6,7 +6,7 @@
 
 \usage{atime(
 N, setup, expr.list=NULL, times=10, seconds.limit=0.01, verbose=FALSE,
-result=FALSE, ...)}
+result=FALSE, N.env.parent=NULL...)}
 
 \arguments{
   \item{N}{numeric vector of at least two data sizes, default is \code{2^seq(2,20)}.}
@@ -18,7 +18,10 @@ result=FALSE, ...)}
   \item{verbose}{logical, print messages after every data size?}
   \item{result}{logical, save each result? If \code{TRUE}, and result is
   a data frame with one row, then the numeric column names will be
-  saved as more units to analyze (in addition to kilobytes and seconds).}
+  saved as more units to analyze (in addition to kilobytes and
+  seconds).}
+  \item{N.env.parent}{environment to use as parent of environment
+  created for each data size N, or NULL to use default parent env.}
   \item{\dots}{named expressions to time.}
 }
 

man/atime_versions.Rd

@@ -8,6 +8,7 @@ atime_versions(
  pkg.path, N, setup, expr, sha.vec=NULL,
  times=10, seconds.limit=0.01, verbose=FALSE,
  pkg.edit.fun=pkg.edit.default, result=FALSE,
+ N.env.parent=NULL,
  ...)
 }
 \arguments{
@@ -38,6 +39,8 @@ atime_versions(
     installation, should typically replace instances of PKG with
     PKG.SHA, default works with Rcpp packages.}
   \item{result}{logical, save results? (default FALSE)}
+  \item{N.env.parent}{environment to use as parent of environment
+  created for each data size N, or NULL to use default parent env.}
   \item{\dots}{named versions.}
 }
 \details{

tests/testthat/test-versions.R

@@ -95,10 +95,12 @@ test_that("pkg.edit.fun is a function", {
   test.env <- atime::atime_pkg_test_info(pkg.dir)
   test_N_expr <- test.env$test.list$test_N_expr
   expect_identical(test_N_expr$pkg.edit.fun, test.env$edit.data.table)
-  expect_identical(test_N_expr$N, 2)
+  expect_identical(test_N_expr$N, c(2,20))
   expect_identical(test_N_expr$expr, quote(rnorm(N)))
   test_expr <- test.env$test.list$test_expr
   expect_identical(test_expr$pkg.edit.fun, test.env$edit.data.table)
-  expect_identical(test_expr$N, 9)
+  expect_identical(test_expr$N, c(9,90))
   expect_identical(test_expr$expr, quote(rnorm(N)))
+  e.res <- eval(test.env$test.call[["global_var_in_setup"]])
+  expect_is(e.res, "atime")
 })