Add options= to test(), convert most Rraw scripts

Author: MichaelChirico

R/test.data.table.R

@@ -249,7 +249,11 @@ gc_mem = function() {
   # nocov end
 }
 
-test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,notOutput=NULL,ignore.warning=NULL) {
+test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,notOutput=NULL,ignore.warning=NULL,options=NULL) {
+  if (!is.null(options)) {
+    old_options <- do.call('options', as.list(options)) # as.list(): allow passing named character vector for convenience
+    on.exit(options(old_options), add=TRUE)
+  }
   # Usage:
   # i) tests that x equals y when both x and y are supplied, the most common usage
   # ii) tests that x is TRUE when y isn't supplied
@@ -280,7 +284,7 @@ test = function(num,x,y=TRUE,error=NULL,warning=NULL,message=NULL,output=NULL,no
     foreign = get("foreign", parent.frame())
     showProgress = get("showProgress", parent.frame())
     time = nTest = RSS = NULL  # to avoid 'no visible binding' note
-    if (num>0) on.exit( {
+    if (num>0) on.exit( add=TRUE, {
        took = proc.time()[3L]-lasttime  # so that prep time between tests is attributed to the following test
        timings[as.integer(num), `:=`(time=time+took, nTest=nTest+1L), verbose=FALSE]
        if (memtest) {

inst/tests/benchmark.Rraw

@@ -81,15 +81,17 @@ test(655, abs(tt1["user.self"] - tt2["user.self"])<2.0)  # unoptimized tt2 takes
 # Test for optimisation of 'order' to 'forder'.
 set.seed(45L)
 DT <- data.table(x=sample(1e2, 1e6,TRUE), y=sample(1e2, 1e6,TRUE))
-old = options(datatable.optimize=Inf)
-t1 = system.time(ans1 <- DT[order(x,-y)])[['elapsed']]   # optimized to forder()
-t2 = system.time(ans2 <- DT[base_order(x,-y)])[['elapsed']]  # not optimized
-test(1241.1, ans1, ans2)
-if (.devtesting) test(1241.2, t1 < t2+0.1)
-# 0.2 < 3.8 on Matt's laptop seems safe enough to test.
-# Even so, 1241.2 has been known to fail, perhaps if system swaps and this R sessions pauses or something?
-# We shouldn't have timing tests here that run on CRAN for this reason.  Hence wrapping with .devtesting
-options(old)
+local({
+  old = options(datatable.optimize=Inf)
+  on.exit(options(old))
+  t1 = system.time(ans1 <- DT[order(x,-y)])[['elapsed']]   # optimized to forder()
+  t2 = system.time(ans2 <- DT[base_order(x,-y)])[['elapsed']]  # not optimized
+  test(1241.1, ans1, ans2)
+  if (.devtesting) test(1241.2, t1 < t2+0.1)
+  # 0.2 < 3.8 on Matt's laptop seems safe enough to test.
+  # Even so, 1241.2 has been known to fail, perhaps if system swaps and this R sessions pauses or something?
+  # We shouldn't have timing tests here that run on CRAN for this reason.  Hence wrapping with .devtesting
+})
 
 
 # fwrite showProgress test 1735. Turned off as too long/big for CRAN.

inst/tests/froll.Rraw

@@ -154,13 +154,11 @@ test(4.24, colnamesInt(dt, "a"), error="has no names")
 
 # verbose
 dt = data.table(a=c(1L, 2L, NA_integer_), b=c(1, 2, NA_real_))
-old=options(datatable.verbose=TRUE)
-test(5.01, nafill(dt, "locf"), output="nafillInteger: took.*nafillDouble: took.*nafillR.*took")
-test(5.02, setnafill(dt, "locf"), output="nafillInteger: took.*nafillDouble: took.*nafillR.*took")
+test(5.01, options = c(datatable.verbose = TRUE), nafill(dt, "locf"), output="nafillInteger: took.*nafillDouble: took.*nafillR.*took")
+test(5.02, options = c(datatable.verbose = TRUE), setnafill(dt, "locf"), output="nafillInteger: took.*nafillDouble: took.*nafillR.*took")
 if (test_bit64) {
-  test(5.03, nafill(as.integer64(c(NA,2,NA,3)), "locf"), as.integer64(c(NA,2,2,3)), output="nafillInteger64: took.*nafillR.*took")
+  test(5.03, options = c(datatable.verbose = TRUE), nafill(as.integer64(c(NA,2,NA,3)), "locf"), as.integer64(c(NA,2,2,3)), output="nafillInteger64: took.*nafillR.*took")
 }
-options(old)
 
 # coerceAs int/numeric/int64 as used in nafill
 if (test_bit64) {
@@ -243,65 +241,61 @@ if (test_bit64) {
 }
 
 # coerceAs verbose
-options(datatable.verbose=2L)
 input = 1
-test(10.01, ans<-coerceAs(input, 1), 1, output="double[numeric] into double[numeric]")
-test(10.02, address(input)!=address(ans))
-test(10.03, ans<-coerceAs(input, 1, copy=FALSE), 1, output="copy=false and input already of expected type and class double[numeric]")
-test(10.04, address(input), address(ans))
-test(10.05, ans<-coerceAs(input, 1L), 1L, output="double[numeric] into integer[integer]")
-test(10.06, address(input)!=address(ans))
-test(10.07, ans<-coerceAs(input, 1L, copy=FALSE), 1L, output="double[numeric] into integer[integer]", notOutput="copy=false")
-test(10.08, address(input)!=address(ans))
-test(10.09, coerceAs("1", 1L), 1L, output="character[character] into integer[integer]", warning="Coercing.*character.*integer")
-test(10.10, coerceAs("1", 1), 1, output="character[character] into double[numeric]", warning="Coercing.*character.*double")
-test(10.11, coerceAs("a", factor("x")), factor("a", levels=c("x","a")), output="character[character] into integer[factor]") ## levels of 'as' are retained!
-test(10.12, coerceAs("a", factor()), factor("a"), output="character[character] into integer[factor]")
-test(10.13, coerceAs(1, factor("x")), factor("x"), output="double[numeric] into integer[factor]")
-test(10.14, coerceAs(1, factor("x", levels=c("x","y"))), factor("x", levels=c("x","y")), output="double[numeric] into integer[factor]")
-test(10.15, coerceAs(2, factor("x", levels=c("x","y"))), factor("y", levels=c("x","y")), output="double[numeric] into integer[factor]")
-test(10.16, coerceAs(1:2, factor(c("x","y"))), factor(c("x","y")), output="integer[integer] into integer[factor]")
-test(10.17, coerceAs(1:3, factor(c("x","y"))), output="integer[integer] into integer[factor]", error="factor numbers.*3 is outside the level range")
-test(10.18, coerceAs(c(1,2,3), factor(c("x","y"))), output="double[numeric] into integer[factor]", error="factor numbers.*3.000000 is outside the level range")
-test(10.19, coerceAs(factor("x"), factor(c("x","y"))), factor("x", levels=c("x","y")), output="integer[factor] into integer[factor]")
-test(10.20, coerceAs(factor("x"), factor(c("x","y")), copy=FALSE), factor("x", levels=c("x","y")), output="input already of expected type and class") ## copy=F has copyMostAttrib
+test(10.01, options = c(datatable.verbose = 2L), ans<-coerceAs(input, 1), 1, output="double[numeric] into double[numeric]")
+test(10.02, options = c(datatable.verbose = 2L), address(input)!=address(ans))
+test(10.03, options = c(datatable.verbose = 2L), ans<-coerceAs(input, 1, copy=FALSE), 1, output="copy=false and input already of expected type and class double[numeric]")
+test(10.04, options = c(datatable.verbose = 2L), address(input), address(ans))
+test(10.05, options = c(datatable.verbose = 2L), ans<-coerceAs(input, 1L), 1L, output="double[numeric] into integer[integer]")
+test(10.06, options = c(datatable.verbose = 2L), address(input)!=address(ans))
+test(10.07, options = c(datatable.verbose = 2L), ans<-coerceAs(input, 1L, copy=FALSE), 1L, output="double[numeric] into integer[integer]", notOutput="copy=false")
+test(10.08, options = c(datatable.verbose = 2L), address(input)!=address(ans))
+test(10.09, options = c(datatable.verbose = 2L), coerceAs("1", 1L), 1L, output="character[character] into integer[integer]", warning="Coercing.*character.*integer")
+test(10.10, options = c(datatable.verbose = 2L), coerceAs("1", 1), 1, output="character[character] into double[numeric]", warning="Coercing.*character.*double")
+test(10.11, options = c(datatable.verbose = 2L), coerceAs("a", factor("x")), factor("a", levels=c("x","a")), output="character[character] into integer[factor]") ## levels of 'as' are retained!
+test(10.12, options = c(datatable.verbose = 2L), coerceAs("a", factor()), factor("a"), output="character[character] into integer[factor]")
+test(10.13, options = c(datatable.verbose = 2L), coerceAs(1, factor("x")), factor("x"), output="double[numeric] into integer[factor]")
+test(10.14, options = c(datatable.verbose = 2L), coerceAs(1, factor("x", levels=c("x","y"))), factor("x", levels=c("x","y")), output="double[numeric] into integer[factor]")
+test(10.15, options = c(datatable.verbose = 2L), coerceAs(2, factor("x", levels=c("x","y"))), factor("y", levels=c("x","y")), output="double[numeric] into integer[factor]")
+test(10.16, options = c(datatable.verbose = 2L), coerceAs(1:2, factor(c("x","y"))), factor(c("x","y")), output="integer[integer] into integer[factor]")
+test(10.17, options = c(datatable.verbose = 2L), coerceAs(1:3, factor(c("x","y"))), output="integer[integer] into integer[factor]", error="factor numbers.*3 is outside the level range")
+test(10.18, options = c(datatable.verbose = 2L), coerceAs(c(1,2,3), factor(c("x","y"))), output="double[numeric] into integer[factor]", error="factor numbers.*3.000000 is outside the level range")
+test(10.19, options = c(datatable.verbose = 2L), coerceAs(factor("x"), factor(c("x","y"))), factor("x", levels=c("x","y")), output="integer[factor] into integer[factor]")
+test(10.20, options = c(datatable.verbose = 2L), coerceAs(factor("x"), factor(c("x","y")), copy=FALSE), factor("x", levels=c("x","y")), output="input already of expected type and class") ## copy=F has copyMostAttrib
 a = structure("a", class="a")
 b = structure("b", class="b")
-test(10.21, coerceAs(a, b), structure("a", class="b"), output="character[a] into character[b]")
+test(10.21, options = c(datatable.verbose = 2L), coerceAs(a, b), structure("a", class="b"), output="character[a] into character[b]")
 a = structure(1L, class="a")
 b = structure(2L, class="b")
-test(10.22, coerceAs(a, b), structure(1L, class="b"), output="integer[a] into integer[b]")
+test(10.22, options = c(datatable.verbose = 2L), coerceAs(a, b), structure(1L, class="b"), output="integer[a] into integer[b]")
 a = structure(1, class="a")
 b = structure(2, class="b")
-test(10.23, coerceAs(a, b), structure(1, class="b"), output="double[a] into double[b]")
+test(10.23, options = c(datatable.verbose = 2L), coerceAs(a, b), structure(1, class="b"), output="double[a] into double[b]")
 a = structure(1, class="a")
 b = structure(2L, class="b")
-test(10.24, coerceAs(a, b), structure(1L, class="b"), output="double[a] into integer[b]")
+test(10.24, options = c(datatable.verbose = 2L), coerceAs(a, b), structure(1L, class="b"), output="double[a] into integer[b]")
 if (test_bit64) {
   x = as.integer64(1L)
-  test(10.81, coerceAs(x, 1), 1, output="double[integer64] into double[numeric]")
-  test(10.82, coerceAs(x, 1L), 1L, output="double[integer64] into integer[integer]")
-  test(10.83, coerceAs(x, "1"), "1", output="double[integer64] into character[character]")
-  test(10.84, coerceAs(1, x), x, output="double[numeric] into double[integer64]")
-  test(10.85, coerceAs(1L, x), x, output="integer[integer] into double[integer64]")
-  test(10.86, coerceAs("1", x), x, output="character[character] into double[integer64]", warning="Coercing.*character")
-  options(datatable.verbose=3L)
-  test(10.87, coerceAs(x, 1L), 1L, output=c("double[integer64] into integer[integer]","Zero-copy coerce when assigning 'integer64' to 'integer'"))
-  test(10.88, coerceAs(1L, x), x, output=c("integer[integer] into double[integer64]","Zero-copy coerce when assigning 'integer' to 'integer64'"))
-  options(datatable.verbose=2L)
-  test(10.89, coerceAs(-2147483649, x), as.integer64(-2147483649), output="double[numeric] into double[integer64]")
+  test(10.81, options = c(datatable.verbose = 2L), coerceAs(x, 1), 1, output="double[integer64] into double[numeric]")
+  test(10.82, options = c(datatable.verbose = 2L), coerceAs(x, 1L), 1L, output="double[integer64] into integer[integer]")
+  test(10.83, options = c(datatable.verbose = 2L), coerceAs(x, "1"), "1", output="double[integer64] into character[character]")
+  test(10.84, options = c(datatable.verbose = 2L), coerceAs(1, x), x, output="double[numeric] into double[integer64]")
+  test(10.85, options = c(datatable.verbose = 2L), coerceAs(1L, x), x, output="integer[integer] into double[integer64]")
+  test(10.86, options = c(datatable.verbose = 2L), coerceAs("1", x), x, output="character[character] into double[integer64]", warning="Coercing.*character")
+  test(10.87, options = c(datatable.verbose = 3L), coerceAs(x, 1L), 1L, output=c("double[integer64] into integer[integer]","Zero-copy coerce when assigning 'integer64' to 'integer'"))
+  test(10.88, options = c(datatable.verbose = 3L), coerceAs(1L, x), x, output=c("integer[integer] into double[integer64]","Zero-copy coerce when assigning 'integer' to 'integer64'"))
+  test(10.89, options = c(datatable.verbose = 2L), coerceAs(-2147483649, x), as.integer64(-2147483649), output="double[numeric] into double[integer64]")
 }
 if (test_nanotime) {
   x = nanotime(1L)
-  test(10.91, coerceAs(x, 1), 1, output="double[nanotime] into double[numeric]")
-  test(10.92, coerceAs(x, 1L), 1L, output="double[nanotime] into integer[integer]")
-  test(10.93, substring(coerceAs(x, "1"),1,11) %in% c("1","1970-01-01T"), output="double[nanotime] into character[character]")
-                                                     # ^ https://github.com/eddelbuettel/nanotime/issues/92; %in% so as not to break if nanotime adds as.character method
-  test(10.94, coerceAs(1, x), x, output="double[numeric] into double[nanotime]")
-  test(10.95, coerceAs(1L, x), x, output="integer[integer] into double[nanotime]")
-  test(10.96, coerceAs("1", x), x, output="character[character] into double[nanotime]", warning="Coercing.*character")
+  test(10.91, options = c(datatable.verbose = 2L), coerceAs(x, 1), 1, output="double[nanotime] into double[numeric]")
+  test(10.92, options = c(datatable.verbose = 2L), coerceAs(x, 1L), 1L, output="double[nanotime] into integer[integer]")
+  test(10.93, options = c(datatable.verbose = 2L), substring(coerceAs(x, "1"),1,11) %in% c("1","1970-01-01T"), output="double[nanotime] into character[character]")
+                                                                                                                      # ^ https://github.com/eddelbuettel/nanotime/issues/92; %in% so as not to break if nanotime adds as.character method
+  test(10.94, options = c(datatable.verbose = 2L), coerceAs(1, x), x, output="double[numeric] into double[nanotime]")
+  test(10.95, options = c(datatable.verbose = 2L), coerceAs(1L, x), x, output="integer[integer] into double[nanotime]")
+  test(10.96, options = c(datatable.verbose = 2L), coerceAs("1", x), x, output="character[character] into double[nanotime]", warning="Coercing.*character")
 }
-options(datatable.verbose=FALSE)
 test(11.01, coerceAs(list(a=1), 1), error="is not atomic")
 test(11.02, coerceAs(1, list(a=1)), list(1))
 test(11.03, coerceAs(sum, 1), error="is not atomic")
@@ -328,7 +322,4 @@ test(11.09, coerceAs(1L, a), error="must not be matrix or array")
 test(99.1, data.table(a=1,b=2)[1,1, verbose=1], error="verbose must be logical or integer")
 test(99.2, data.table(a=1,b=2)[1,1, verbose=1:2], error="verbose must be length 1 non-NA")
 test(99.3, data.table(a=1,b=2)[1,1, verbose=NA], error="verbose must be length 1 non-NA")
-options(datatable.verbose=1)
-test(99.4, coerceAs(1, 2L), error="verbose option must be length 1 non-NA logical or integer")
-options(datatable.verbose=FALSE)
-
+test(99.4, options = c(datatable.verbose = 1), coerceAs(1, 2L), error="verbose option must be length 1 non-NA logical or integer")