RFC: fail test.data.table() if non-test code produces warnings (#7210)

* test.data.table: catch warnings outside test code

* Use explicit environment assignment instead of <<-

* Thinko: length -> nrow

* tests 2253*: suppressWarnings, skip if no UTF-8

* tests: remember tracebacks from warnings

* Thinko: length -> nrow

* suppressWarnings(Sys.setlocale(...))

On modern versions of R for Windows, Sys.setlocale() warns for non-UTF-8
locales.

Also comment the previous instance of suppressWarnings().

* Apply fixes from code review

* conditionMessage() instead of toString()
* apply names earlier
* don't check for zero-length calls in sys.calls()
* be careful not to over-translate an already-translated message

Co-Authored-By: Michael Chirico <[email protected]>

---------

Co-authored-by: Michael Chirico <[email protected]>

Author: aitap

R/test.data.table.R

@@ -205,7 +205,30 @@ test.data.table = function(script="tests.Rraw", verbose=FALSE, pkg=".", silent=F
   }
   # nocov end
 
-  err = try(sys.source(fn, envir=env), silent=silent)
+  env$warnings = list()
+  err = try(
+    withCallingHandlers(
+      sys.source(fn, envir=env),
+      warning=function(w) {
+        # nocov start
+        if (!silent && showProgress) print(w)
+        env$warnings = c(env$warnings, list(list(
+          "after test"=env$prevtest, warning=conditionMessage(w),
+          calls=paste(
+            vapply_1c(sys.calls(), function(call) {
+              if (is.name(call[[1]])) {
+                as.character(call[[1]])
+              } else "..."
+            }),
+            collapse=" -> "
+          )
+        )))
+        invokeRestart("muffleWarning")
+        # nocov end
+      }
+    ),
+    silent=silent
+  )
 
   options(oldOptions)
   for (i in oldEnv) {
@@ -262,6 +285,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(env$warnings)) {
+    # nocov start
+    warnings = rbindlist(env$warnings)
+    catf(
+      ngettext(nrow(warnings),
+        "Caught %d warning outside the test() calls:\n",
+        "Caught %d warnings outside the test() calls:\n"
+      ),
+      nrow(warnings),
+      domain=NA
+    )
+    print(warnings, nrows = nrow(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

inst/tests/tests.Rraw

@@ -16996,7 +16996,8 @@ if (.Platform$OS.type=="windows") local({
     LC_TIME = "Chinese (Simplified)_China.936"
   )
   x_old = Map(Sys.getlocale, names(x))
-  invisible(Map(Sys.setlocale, names(x), x))
+  # setlocale() warns for non-UTF-8 locales in modern versions of R, #7210
+  suppressWarnings(invisible(Map(Sys.setlocale, names(x), x)))
   on.exit(Map(Sys.setlocale, names(x_old), x_old))
   # triggered segfault here in #4402, Windows-only under translation.
   # test that the argument order changes correctly (the 'item 2' moves to the beginning of the message)
@@ -18615,12 +18616,18 @@ test(2252.2, dt[, let(b=2L)], error = "\\[ was called on a data.table.*not data.
 rm(.datatable.aware)
 
 # tests for trunc.char handling wide characters # 5096
-local({
+local(if (l10n_info()$`UTF-8` || {
   lc_ctype = Sys.getlocale('LC_CTYPE')
+  lc_wantctype = 'en_US.UTF-8'
   # Japanese multibyte characters require utf8. As of 2025, we're likely to be already running in a UTF-8 locale, but if not, try this setlocale() call as a last chance.
   # Unfortunately, there is no guaranteed, portable way of switching to UTF-8 US English.
-  if (!l10n_info()$`UTF-8`) Sys.setlocale('LC_CTYPE', "en_US.UTF-8")
-  on.exit(Sys.setlocale('LC_CTYPE', lc_ctype))
+  # Avoid the warning upon possible failure, #7210.
+  lc_newctype = suppressWarnings(Sys.setlocale('LC_CTYPE', lc_wantctype))
+  if (identical(lc_newctype, lc_wantctype)) {
+    on.exit(Sys.setlocale('LC_CTYPE', lc_ctype))
+    TRUE
+  } else FALSE
+}) {
   accented_a = "\u0061\u0301"
   ja_ichi = "\u4E00"
   ja_ni = "\u4E8C"
@@ -18670,6 +18677,8 @@ local({
     paste0(c(ja_ko, ja_n, accented_a), dots, collapse=" ")))
   # test for data.table with NA, #6441
   test(2253.20, options=list(datatable.prettyprint.char = 1L), data.table(a = c("abc", NA)), output="      a\n1: a...\n2: <NA>")
+} else {
+  cat("Tests 2253* skipped because they need a UTF-8 locale.\n")
 })
 
 # allow 1-D matrix in j for consistency, #783