Merge pull request #162 from r-lib/fix/test-fail-as-cran

Author: gaborcsardi

R/callback.R

@@ -7,7 +7,10 @@
 #' @importFrom utils head tail
 #' @importFrom prettyunits pretty_dt
 
-block_callback <- function(top_line = TRUE, sys_time = NULL) {
+block_callback <- function(
+    top_line = TRUE,
+    sys_time = NULL,
+    as_cran = NA) {
 
   sys_time <- sys_time %||% Sys.time
   partial_line <- ""
@@ -99,26 +102,6 @@ block_callback <- function(top_line = TRUE, sys_time = NULL) {
     }
   }
 
-  ## The output from the tests is a bit messed up, especially if we
-  ## want to process it line by line.
-  ## The tests start with '* checking test ...\n' and then when a test
-  ## file starts running we see sg like '  Running 'testthat.R''
-  ## This is without the newline character.
-  ##
-  ## The first test file that errors out will stop the tests entirely.
-  ##
-  ## When a test file is done, we get a '\n', and then either the next one
-  ## is started with another '  Running ...' line (without \n), or they are
-  ## done completely, and we get a '\n' and ' ERROR\n' / ' OK\n' depending
-  ## on the result.
-  ##
-  ## So the tricky thing is, we can only update a 'Running ' line after
-  ## we already know what is in the next line. If the next line is ' ERROR',
-  ## then the test file failed, otherwise succeeded. So we also do the actual
-  ## updating based on the '  Running' partial lines.
-  ##
-  ## As usually, prev_line contains the previous line.
-
   do_test_mode <- function(x) {
     ## Maybe we just learned the result of the current test file
     if (test_running) {
@@ -132,7 +115,14 @@ block_callback <- function(top_line = TRUE, sys_time = NULL) {
         ## Tests are over, error
         state <<- "ERROR"
         test_running <<- FALSE
-        xx <- style(err = "E", pale = no(prev_line))
+        if (isTRUE(as_cran)) {
+          xp <- style(pale = symbol$line, pale = no(prev_line))
+          xp <- style(xp, timing = time_if_long())
+          cat(xp, "\n", sep = "")
+          xx <- style(err = "E", pale = "  Some test files failed")
+        } else {
+          xx <- style(err = "E", pale = no(prev_line))
+        }
         xx <- style(xx, timing = time_if_long())
       } else if (grepl("^\\s+Comparing", x)) {
         ## Comparison
@@ -141,7 +131,11 @@ block_callback <- function(top_line = TRUE, sys_time = NULL) {
         xx <- style(xx, timing = time_if_long())
       } else if (grepl("^\\s+Running", x)) {
         ## Next test is running now, state unchanged
-        xx <- style(ok = symbol$tick, pale = no(prev_line))
+        if (isTRUE(as_cran)) {
+          xx <- style(pale = symbol$line, pale = no(prev_line))
+        } else {
+          xx <- style(ok = symbol$tick, pale = no(prev_line))
+        }
         xx <- style(xx, timing = time_if_long())
         now <<- sys_time()
       } else {
@@ -190,7 +184,11 @@ block_callback <- function(top_line = TRUE, sys_time = NULL) {
       if (grepl("^\\s+Running ", x) || grepl("^\\s+Comparing", x)) {
         test_running <<- FALSE
         if (grepl("^\\s+Running ", x)) {
-          xx <- style(ok = symbol$tick, pale = no(prev_line))
+          if (isTRUE(as_cran)) {
+            xx <- style(pale = symbol$line, pale = no(prev_line))
+          } else {
+            xx <- style(ok = symbol$tick, pale = no(prev_line))
+          }
           xx <- style(xx, timing = time_if_long())
         } else {
           xx <- style(ok = symbol$tick, pale = prev_line)
@@ -224,14 +222,14 @@ is_new_check <- function(x) {
   grepl("^\\*\\*? ", x)
 }
 
-simple_callback <- function(top_line = TRUE, sys_time = NULL) {
+simple_callback <- function(top_line = TRUE, sys_time = NULL, ...) {
   function(x) cat(gsub("[\r\n]+", "\n", x, useBytes = TRUE))
 }
 
 #' @importFrom cli is_dynamic_tty
 
-detect_callback <- function() {
-  if (cli::is_dynamic_tty()) block_callback() else simple_callback()
+detect_callback <- function(...) {
+  if (cli::is_dynamic_tty()) block_callback(...) else simple_callback(...)
 }
 
 should_add_spinner <- function() {

R/package.R

@@ -208,7 +208,7 @@ do_check <- function(targz, package, args, libpath, repos,
       user_profile = TRUE,
       repos = repos,
       stderr = "2>&1",
-      block_callback = if (!quiet) detect_callback(),
+      block_callback = if (!quiet) detect_callback(as_cran = "--as-cran" %in% args),
       spinner = !quiet && should_add_spinner(),
       timeout = timeout,
       fail_on_status = FALSE

tests/testthat/_snaps/callback.md

@@ -532,3 +532,41 @@
       [71] ""                                                                              
       [72] "Status: OK"                                                                    
 
+# multiple tests
+
+    Code
+      out
+    Output
+       [1] "  \r-  checking examples ... NONE"                     
+       [2] "\r  \rv  checking for unstated dependencies in ‘tests’"
+       [3] "\r  \r-  checking tests"                               
+       [4] "\r  \r\r  \r-  Running ‘a.R’"                          
+       [5] "\r  \r-  Running ‘b.R’"                                
+       [6] "\r  \r-  Running ‘c.R’"                                
+       [7] "E  Some test files failed"                             
+       [8] "\r  \r   Running the tests in ‘tests/b.R’ failed."     
+       [9] "\r  \r   Complete output:"                             
+      [10] "\r  \r     > stop(\"error\")"                          
+      [11] "\r  \r     Error: error"                               
+      [12] "\r  \r     Execution halted"                           
+      [13] "\r  \rv  checking PDF version of manual"               
+      [14] "\r"                                                    
+
+---
+
+    Code
+      out
+    Output
+       [1] "  \r-  checking examples ... NONE"                     
+       [2] "\r  \rv  checking for unstated dependencies in ‘tests’"
+       [3] "\r  \r-  checking tests"                               
+       [4] "\r  \r\r  \rv  Running ‘a.R’"                          
+       [5] "\r  \rE  Running ‘b.R’"                                
+       [6] "\r  \r   Running the tests in ‘tests/b.R’ failed."     
+       [7] "\r  \r   Complete output:"                             
+       [8] "\r  \r     > stop(\"error\")"                          
+       [9] "\r  \r     Error: error"                               
+      [10] "\r  \r     Execution halted"                           
+      [11] "\r  \rv  checking PDF version of manual"               
+      [12] "\r"                                                    
+

tests/testthat/fixtures/tests-as-cran.txt

@@ -0,0 +1,13 @@
+* checking examples ... NONE
+* checking for unstated dependencies in ‘tests’ ... OK
+* checking tests ...
+  Running ‘a.R’
+  Running ‘b.R’
+  Running ‘c.R’
+ ERROR
+Running the tests in ‘tests/b.R’ failed.
+Complete output:
+  > stop("error")
+  Error: error
+  Execution halted
+* checking PDF version of manual ... OK

tests/testthat/fixtures/tests-not-as-cran.txt

@@ -0,0 +1,12 @@
+* checking examples ... NONE
+* checking for unstated dependencies in ‘tests’ ... OK
+* checking tests ...
+  Running ‘a.R’
+  Running ‘b.R’
+ ERROR
+Running the tests in ‘tests/b.R’ failed.
+Complete output:
+  > stop("error")
+  Error: error
+  Execution halted
+* checking PDF version of manual ... OK

tests/testthat/test-callback.R

@@ -127,7 +127,7 @@ test_that("multiple test file run times are measured properly", {
 
 test_that("multi-arch test cases", {
   txt <- list(
-    list("* using log directory 'C:/Users/csard/works/ps.Rcheck'\n", 0.01), 
+    list("* using log directory 'C:/Users/csard/works/ps.Rcheck'\n", 0.01),
     list("* using R version 4.1.1 (2021-08-10)\n", 0.01),
     list("* using platform: x86_64-w64-mingw32 (64-bit)\n", 0.01),
     list("* using session charset: ISO8859-1\n", 0.01),
@@ -173,7 +173,7 @@ test_that("partial comparing line", {
     list("  Comparing ‘test-2.Rout’ to ‘test-2.Rout.save’ ... OK\n", 0),
     list(" OK\n", 0.01),
     list("* checking PDF version of manual ... OK\n", 0.01),
-    list("* DONE\n", 0.01)    
+    list("* DONE\n", 0.01)
   )
 
   out <- capture.output(replay(lines))
@@ -184,7 +184,7 @@ test_that("multiple comparing blocks", {
   txt <- readLines(test_path("fixtures", "checks", "comparing2.txt"))[53:88]
   lines <- lapply(txt, function(x) list(paste0(x, "\n"), 0.001))
   out <- capture.output(replay(lines))
-  expect_snapshot(out)  
+  expect_snapshot(out)
 })
 
 test_that("simple_callback", {
@@ -200,7 +200,7 @@ test_that("detect_callback", {
 
   withr::local_options(cli.dynamic = TRUE)
   expect_equal(detect_callback(), "block")
-  
+
   withr::local_options(cli.dynamic = FALSE)
   expect_equal(detect_callback(), "simple")
 })
@@ -211,3 +211,16 @@ test_that("should_add_spinner", {
   withr::local_options(cli.dynamic = FALSE)
   expect_false(should_add_spinner())
 })
+
+test_that("multiple tests", {
+  txt <- readLines(test_path("fixtures", "tests-as-cran.txt"))
+  lines <- lapply(txt, function(x) list(paste0(x, "\n"), 0.001))
+  cb <- function(...) block_callback(as_cran = TRUE, ...)
+  out <- capture.output(replay(lines, callback = cb))
+  expect_snapshot(out)
+
+  txt <- readLines(test_path("fixtures", "tests-not-as-cran.txt"))
+  lines <- lapply(txt, function(x) list(paste0(x, "\n"), 0.001))
+  out <- capture.output(replay(lines))
+  expect_snapshot(out)
+})