test.data.table: catch warnings outside test code

Author: aitap

R/test.data.table.R

@@ -205,7 +205,20 @@ test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=F
   }
   # nocov end
 
-  err = try(sys.source(fn, envir=env), silent=silent)
+  warnings = list()
+  err = try(
+    withCallingHandlers(
+      sys.source(fn, envir=env),
+      warning=function(w) {
+        # nocov start
+        if (!silent && showProgress) print(w)
+        warnings <<- c(warnings, list(list(env$prevtest, toString(w))))
+        invokeRestart("muffleWarning")
+        # nocov end
+      }
+    ),
+    silent=silent
+  )
 
   options(oldOptions)
   for (i in oldEnv) {
@@ -262,6 +275,21 @@ test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=F
     # important to stopf() here, so that 'R CMD check' fails
     # nocov end
   }
+  if (length(warnings)) {
+    # nocov start
+    warnings = rbindlist(warnings)
+    setnames(warnings, c("after test", "warning"))
+    catf(
+      ngettext(length(warnings),
+        "Caught %d warning outside the test() calls:\n",
+        "Caught %d warnings outside the test() calls:\n"
+      ),
+      length(warnings)
+    )
+    print(warnings)
+    stopf("Tests succeeded, but non-test code caused warnings. Search %s for tests shown above.", names(fn))
+    # nocov end
+  }
 
   # There aren't any errors, so we can use up 11 lines for the timings table
   time = nTest = RSS = NULL  # to avoid 'no visible binding' note