test set feature #28

gather all assertions about a function in a sort of spec
RevolutionAnalytics · Apr 16, 2015 · cb09f28 · cb09f28
1 parent d67e889
commit cb09f28
Show file tree

Hide file tree

Showing 4 changed files with 205 additions and 169 deletions.
diff --git a/pkg/NAMESPACE b/pkg/NAMESPACE
@@ -18,6 +18,7 @@ export(rlogical)
 export(rraw)
 export(rsize)
 export(test)
+export(test.set)
 export(expect)
 export(repro)
 export(coverage)
@@ -27,6 +28,7 @@ export(default)
 export(`%||%`)
 export(forall)
 S3method(coverage, character)
+S3method(print, TestSet)
 importFrom(functional, Curry)
 importFrom(digest, digest)
 import(testthat)

diff --git a/pkg/R/quickcheck.R b/pkg/R/quickcheck.R
@@ -214,9 +214,8 @@ test =
               list(args = args, pass = result$pass, elapsed = result$elapsed)})}
     if(!is.null(cover)) {
       check.covr()
-      env = parent.frame()
-      cov = covr::function_coverage(cover, run(), env = env)
-      cover.fun = get(cover, envir = env)
+      cov = covr::function_coverage(cover, run(), env = envir)
+      cover.fun = get(cover, envir = envir)
       cover.srcfile = as.list.environment(attributes(body(cover.fun))$srcfile %||% attributes(attributes(cover.fun)$srcref)$srcfile)
       if(cover.srcfile$filename == "") {
         srctemp = tempfile()
@@ -228,6 +227,7 @@ test =
     test.report =
       list(
         assertion = assertion,
+        about = about,
         env =
           do.call(
             c,
@@ -271,6 +271,32 @@ test =
       stop("to reproduce enter repro(\"", tf, "\")")}
     invisible(test.report)}
 
+test.set = function(..., block = {}) {
+  test.results =
+    c(
+      list(...),
+      lapply(substitute(block)[-1], eval, envir = parent.frame()))
+  retval =
+    unlist(
+      lapply(
+        test.results,
+        function(x)
+          lapply(
+            x$about,
+            function(name){
+              ll = list()
+              ll[[name]] = x$assertion
+              ll})))
+  retval = structure(retval[sort(names(retval))], class = "TestSet")
+  print(retval)
+  retval}
+
+print.TestSet =
+  function(x, ...){
+    cat("----test set------\n")
+    ll = lapply(x, function(y) paste(capture.output(y), collapse = "\n"))
+    cat(paste("function: ", names(ll), "assertion: ", ll, "\n", sep = "\n", collapse = ""))}
+
 smallest.failed =
   function(pass, cases)
     tail(

diff --git a/pkg/tests/generators.R b/pkg/tests/generators.R
@@ -73,140 +73,144 @@ height =
 			list = 1 + max({mm = sapply(l, height); if(is.list(mm)) 0 else mm}),
 			0)
 
-##rlogical
-type.test(is.logical, rlogical)
-variability.test(rlogical)
-size.test(rlogical)
-test(
-  forall(x = rlogical(c(p = 0)), {!any(x)}))
-test(
-  forall(x =  rlogical(c(p = 1)), {all(x)}))
-
-
-##rinteger
-type.test(is.integer, rinteger)
-variability.test(rinteger)
-range.test(rinteger)
-size.test(rinteger)
-
-##rdouble
-type.test(is.double, rdouble)
-variability.test(rdouble)
-size.test(rdouble)
-test(
-  forall(
-    mean = rdouble(size = ~1),
-    data = rdouble(elements = c(mean = mean, sd = 0)),
-    {all(data == mean)}))
-
-## rnumeric
-type.test(is.numeric, rnumeric)
-variability.test(rnumeric)
-size.test(rnumeric)
-
-##rcharacter:
-type.test(is.character, rcharacter)
-variability.test(rcharacter)
-size.test(rcharacter)
-test(
-  forall(
-    nchar = rsize(),
-    string = rsize(),
-    data = rcharacter(elements = list(nchar = c(max = nchar), string = c(max = string))),
-    {all(sapply(data, nchar) <= nchar)}))
-
-##rfactor
-type.test(is.factor, rfactor)
-variability.test(rfactor)
-size.test(rfactor)
-test(
-  forall(
-    nlevels = rsize(c(min = 1)),
-    data = rfactor(elements =  c(nlevels = nlevels)),
-    {length(unique(data)) <= nlevels}))
-
-##rDate
-
-##rraw
-type.test(is.raw, rraw)
-variability.test(rraw)
-size.test(rraw)
-test(
-  forall(
-    n = rsize(),
-    data = rraw(elements = c(min = n, max = n)),
-    {all(data == as.raw(n))}))
-
-#constant
-test(
-	forall(x = rany(), y = constant(x), {identical(x, y())}))
-
-#rsample
-test(
-  forall(
-    x = rlist(),
-    y = rsample(x),
-    {y %in% x}))
-
-variability.test(Curry(rsample, elements = 1:1000, size =~2))
-
-#rlist
-type.test(is.list, rlist)
-test(
-  forall(
-    l = rlist(),
-    {is.element(rsample(l), l)}))
-
-#mixture
-#very weak test
-test(
-	forall(
-	  n = runif(n = 1),
-	  {is.element(
-	    mixture(
-	      list(
-	        constant(n),
-	        constant(2*n)))(),
-	    c(n,2*n))}))
-
-#rlist
-
-type.test(is.list, rlist)
-variability.test(rlist)
-size.test(rlist)
-
-# rdata.frame
-type.test(is.data.frame, rdata.frame)
-variability.test(rdata.frame)
-nrow.test(rdata.frame)
-ncol.test(rdata.frame)
-
-# rany
-variability.test(rany)
-
-#rmatrix
-
-type.test(is.matrix, rmatrix)
-variability.test(rmatrix)
-nrow.test(rmatrix)
-ncol.test(rmatrix)
-
-#ratomic
-type.test(is.atomic, ratomic)
-variability.test(ratomic)
-
-
-#rfunction
-type.test(is.function, quickcheck:::rfunction)
-variability.test(quickcheck:::rfunction)
-
-#named
-
-test(forall(x = named(ratomic)(), {!is.null(names(x))}))
-test(forall(x = rnamed(ratomic()), {!is.null(names(x))}))
-type.test(is.atomic, named(ratomic))
-
-test(forall(x = named(rlist)(), {!is.null(names(x))}))
-test(forall(x = rnamed(rlist()), {!is.null(names(x))}))
-type.test(is.list, named(rlist))
+test.set(
+  block = {
 
+    ##rlogical
+    type.test(is.logical, rlogical)
+    variability.test(rlogical)
+    size.test(rlogical)
+    test(
+      forall(x = rlogical(c(p = 0)), {!any(x)}))
+    test(
+      forall(x =  rlogical(c(p = 1)), {all(x)}))
+
+
+    ##rinteger
+    type.test(is.integer, rinteger)
+    variability.test(rinteger)
+    range.test(rinteger)
+    size.test(rinteger)
+
+    ##rdouble
+    type.test(is.double, rdouble)
+    variability.test(rdouble)
+    size.test(rdouble)
+    test(
+      forall(
+        mean = rdouble(size = ~1),
+        data = rdouble(elements = c(mean = mean, sd = 0)),
+        {all(data == mean)}))
+
+    ## rnumeric
+    type.test(is.numeric, rnumeric)
+    variability.test(rnumeric)
+    size.test(rnumeric)
+
+    ##rcharacter:
+    type.test(is.character, rcharacter)
+    variability.test(rcharacter)
+    size.test(rcharacter)
+    test(
+      forall(
+        nchar = rsize(),
+        string = rsize(),
+        data = rcharacter(elements = list(nchar = c(max = nchar), string = c(max = string))),
+        {all(sapply(data, nchar) <= nchar)}))
+
+    ##rfactor
+    type.test(is.factor, rfactor)
+    variability.test(rfactor)
+    size.test(rfactor)
+    test(
+      forall(
+        nlevels = rsize(c(min = 1)),
+        data = rfactor(elements =  c(nlevels = nlevels)),
+        {length(unique(data)) <= nlevels}))
+
+    ##rDate
+
+    ##rraw
+    type.test(is.raw, rraw)
+    variability.test(rraw)
+    size.test(rraw)
+    test(
+      forall(
+        n = rsize(),
+        data = rraw(elements = c(min = n, max = n)),
+        {all(data == as.raw(n))}))
+
+    #constant
+    test(
+      forall(x = rany(), y = constant(x), {identical(x, y())}))
+
+    #rsample
+    test(
+      forall(
+        x = rlist(),
+        y = rsample(x),
+        {y %in% x}))
+
+    variability.test(Curry(rsample, elements = 1:1000, size =~2))
+
+    #rlist
+    type.test(is.list, rlist)
+    test(
+      forall(
+        l = rlist(),
+        {is.element(rsample(l), l)}))
+
+    #mixture
+    #very weak test
+    test(
+      forall(
+        n = runif(n = 1),
+        {is.element(
+          mixture(
+            list(
+              constant(n),
+              constant(2*n)))(),
+          c(n,2*n))}))
+
+    #rlist
+
+    type.test(is.list, rlist)
+    variability.test(rlist)
+    size.test(rlist)
+
+    # rdata.frame
+    type.test(is.data.frame, rdata.frame)
+    variability.test(rdata.frame)
+    nrow.test(rdata.frame)
+    ncol.test(rdata.frame)
+
+    # rany
+    variability.test(rany)
+
+    #rmatrix
+
+    type.test(is.matrix, rmatrix)
+    variability.test(rmatrix)
+    nrow.test(rmatrix)
+    ncol.test(rmatrix)
+
+    #ratomic
+    type.test(is.atomic, ratomic)
+    variability.test(ratomic)
+
+
+    #rfunction
+    type.test(is.function, quickcheck:::rfunction)
+    variability.test(quickcheck:::rfunction)
+
+    #named
+
+    test(forall(x = named(ratomic)(), {!is.null(names(x))}))
+    test(forall(x = rnamed(ratomic()), {!is.null(names(x))}))
+    type.test(is.atomic, named(ratomic))
+
+    test(forall(x = named(rlist)(), {!is.null(names(x))}))
+    test(forall(x = rnamed(rlist()), {!is.null(names(x))}))
+    type.test(is.list, named(rlist))
+
+  })