atime_test funs

NAMESPACE

@@ -9,6 +9,8 @@ export(atime_versions)
 export(atime_versions_remove)
 export(atime_versions_exprs)
 export(atime_pkg)
+export(atime_test)
+export(atime_test_list)
 export(glob_find_replace)
 S3method("print", "atime")
 S3method("plot", "atime")

NEWS

@@ -1,6 +1,8 @@
 Changes in version 2024.4.23
 
 - Fix test-CRAN.R: kilobytes is not available on some systems.
+- added atime_test and atime_test_list for convenience in test definitions.
+- atime_versions_exprs now errors if expr has no Package: in code.
 
 Changes in version 2024.4.17
 

R/atime.R

@@ -101,6 +101,9 @@ atime <- function(N, setup, expr.list=NULL, times=10, seconds.limit=0.01, verbos
     stop(domain=NA, gettextf("expr.list should be a list of expressions to run for various N, but has classes %s", paste(class(expr.list), collapse=", ")))
   }
   elist <- c(expr.list, dots.list)
+  if(length(elist)==0){
+    stop("no expressions to measure; please provide at least one expression in ... or expr.list")
+  }
   name.tab <- table(names(elist))
   bad.names <- names(name.tab)[name.tab>1]
   more.units <- character()

R/test.R

@@ -0,0 +1,20 @@
+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])
+  copy.names <- intersect(names(mc), could.copy)
+  L <- c(tests, list(...))
+  out <- list()
+  for(L.i in seq_along(L)){
+    test.args <- L[[L.i]]
+    test.name <- names(L)[[L.i]]
+    if(!is.null(test.args)){
+      test.args[copy.names] <- mc[copy.names]
+      out[[test.name]] <- test.args
+    }
+  }
+  out
+}

R/versions.R

@@ -168,9 +168,12 @@ atime_versions_exprs <- function(pkg.path, expr, sha.vec=NULL, verbose=FALSE, pk
     new.Package <- new.Package.vec[[commit.i]]
     old.lines <- capture.output(substitute(expr))
     new.lines <- gsub(
-      paste0(Package,"(:+)"),
-      paste0(new.Package,"\\1"),
+      paste0(Package,":"),
+      paste0(new.Package,":"),
       old.lines)
+    if(identical(old.lines,new.lines)){
+      stop("expr should contain at least one instance of data.table: to replace with data.table.SHA1:")
+    }
     a.args[[commit.name]] <- str2lang(paste(new.lines, collapse="\n"))
   }
   a.args

man/atime_test.Rd

@@ -0,0 +1,35 @@
+\name{atime_test}
+\alias{atime_test}
+\title{
+  Define an atime performance test.
+}
+\description{
+  Use this to define an element of your \code{test.list} in
+  atime/tests.R, prior to running \code{\link{atime_pkg}}.
+}
+\usage{
+atime_test(...)
+}
+\arguments{
+  \item{\dots}{
+    Any arguments for \code{\link{atime_versions}}, will be quoted (not evaluated).
+}
+}
+\value{
+  List of expressions.
+}
+\author{
+  Toby Dylan Hocking
+}
+\seealso{
+  \code{\link{atime_test_list}} for defining common arguments in each
+  element of the test list,
+  \code{\link{atime_pkg}} for running tests.
+}
+\examples{
+
+atime::atime_test(
+  setup=data.vec <- rnorm(N),
+  expr=binsegRcpp::binseg("mean_norm",data.vec))
+
+}

man/atime_test_list.Rd

@@ -0,0 +1,72 @@
+\name{atime_test_list}
+\alias{atime_test_list}
+\title{
+  Define an atime performance test list.
+}
+\description{
+  Use this to define \code{test.list} in your atime/tests.R
+  file, prior to running \code{\link{atime_pkg}}.
+  Arguments in \dots and \code{tests} are combined to form the test
+  list, and other arguments are copied to each element of the test list.
+}
+\usage{
+atime_test_list(..., N, setup, expr, times, seconds.limit, verbose, pkg.edit.fun, result, tests = NULL)
+}
+\arguments{
+  \item{\dots}{
+    names for tests, values are lists of arguments to pass to
+    \code{\link{atime_versions}} (combined with \code{tests}).
+}
+  \item{tests}{
+    list of tests, with names for tests, values are lists of arguments to pass to
+    \code{\link{atime_versions}} (combined with \dots).
+}
+  \item{N}{
+    integer vector of data sizes.
+}
+  \item{setup}{
+    expression that depends on \code{N}, to run before timings.
+}
+  \item{expr}{
+    expression to time.
+}
+  \item{times}{
+    number of times to run \code{expr}.
+}
+  \item{seconds.limit}{
+    number of seconds after which we stop trying larger \code{N}.
+}
+  \item{verbose}{
+    logical: print output?
+}
+  \item{pkg.edit.fun}{
+    function for editing package prior to testing.
+}
+  \item{result}{
+    logical: save results?
+}
+}
+\value{
+  List representing performance tests, each element is a list of
+  arguments to pass to \code{\link{atime_versions}}.
+}
+\author{
+  Toby Dylan Hocking
+}
+\seealso{
+  \code{\link{atime_test}} for defining each test,
+  \code{\link{atime_pkg}} for running tests.
+}
+\examples{
+
+test.list <- atime::atime_test_list(
+  N=as.integer(10^seq(1,3,by=0.5)),
+  setup={
+    set.seed(1)
+    data.vec <- rnorm(N)
+  },
+  mean_norm=atime::atime_test(expr=binsegRcpp::binseg("mean_norm",data.vec)),
+  poisson=atime::atime_test(expr=binsegRcpp::binseg("poisson",data.vec)),
+  NULL)
+
+}

tests/testthat/test-CRAN.R

@@ -284,6 +284,17 @@ test_that("atime_versions_exprs error when sha.vec element not string", {
   }, "each ... argument value and sha.vec element must be a string (package version, length=1, not NA), problems: N", fixed=TRUE)
 })
 
+test_that("atime_versions_exprs error when expr does not contain pkg:", {
+  expect_error({
+    atime::atime_versions_exprs(
+      pkg.path="~/R/data.table",
+      expr=dt[, .(vs = (sum(val))), by = .(id)],
+      "Before"="be2f72e6f5c90622fe72e1c315ca05769a9dc854",
+      "Regression"="e793f53466d99f86e70fc2611b708ae8c601a451", 
+      "Fixed"="58409197426ced4714af842650b0cc3b9e2cb842") 
+  }, "expr should contain at least one instance of data.table: to replace with data.table.SHA1:", fixed=TRUE)
+})
+
 test_that("atime_versions_exprs error when sha.vec element char vector", {
   expect_error({
     atime::atime_versions_exprs(

tests/testthat/test-versions.R

@@ -27,3 +27,20 @@ test_that("atime_pkg produces tests_all_facet.png", {
   tests_all_facet.png <- file.path(inst.atime, "tests_all_facet.png")
   expect_true(file.exists(tests_all_facet.png))
 })
+
+test_that("atime_pkg produces RData with expected names", {
+  repo <- git2r::repository(tdir)
+  git2r::checkout(repo, branch="atime-test-funs")
+  atime.dir <- file.path(tdir, ".ci", "atime")
+  options(repos="http://cloud.r-project.org")#required to check CRAN version.
+  result.list <- atime::atime_pkg(tdir, ".ci")
+  tests.RData <- file.path(atime.dir, "tests.RData")
+  (objs <- load(tests.RData))
+  expected.names <- c(
+    "binseg(1:N,maxSegs=N/2) DIST=l1",
+    "binseg(1:N,maxSegs=N/2) DIST=meanvar_norm", 
+    "binseg(1:N,maxSegs=N/2) DIST=poisson",
+    "binseg_normal(1:N,maxSegs=N/2)"
+  )
+  expect_identical(names(pkg.results), expected.names)
+})