Merge branch 'main' into test-interrupt

Author: hadley

NEWS.md

@@ -1,12 +1,14 @@
 # testthat (development version)
 
 * Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464)
+* Parallel testthat now does not ignore test files with syntax errors (#1360).
+* `expect_lt()`, `expect_gt()`, and friends have a refined display that is more likely to display the correct number of digits and shows you the actual values compared.
 * `describe()`, `it()`, and `test_that()` now have a shared stack of descriptions so that if you nest any inside of each other, any resulting failures will show you the full path.
 * `describe()` now correctly scopes `skip()` (#2007).
 * `ParallelProgressReporter` now respect `max_failures` (#1162).
 * The last snapshot is no longer lost if the snapshot file is missing the final newline (#2092). It's easy to accidentally remove this because there are two trailing new lines in snapshot files and many editors will automatically remove if you touch the file.
 * New `expect_r6_class()` (#2030).
-* `expect_*()` functions consistently and rigorously check their inputs (#1754). 
+* `expect_*()` functions consistently and rigorously check their inputs (#1754).
 * `JunitReporter()` no longer fails with `"no applicable method for xml_add_child"` for warnings outside of tests (#1913). Additionally, warnings now save their backtraces.
 * `JunitReporter()` strips ANSI escapes in more placese (#1852, #2032).
 * `try_again()` is now publicised. The first argument is now the number of retries, not tries (#2050).

R/expect-comparison.R

@@ -31,21 +31,31 @@ expect_compare_ <- function(
   msg <- c(
     "<" = "not strictly less than",
     "<=" = "not less than",
-    ">" = "not strictly more than",
-    ">=" = "not more than"
+    ">" = "not strictly greater than",
+    ">=" = "not greater than"
   )[[operator]]
 
+  negated_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
+
   cmp <- op(act$val, exp$val)
   if (length(cmp) != 1 || !is.logical(cmp)) {
     abort("Result of comparison must be a single logical value")
   }
   if (!isTRUE(cmp)) {
+    digits <- max(
+      digits(act$val),
+      digits(exp$val),
+      min_digits(act$val, exp$val)
+    )
     msg <- sprintf(
-      "%s is %s %s. Difference: %.3g",
+      "%s is %s %s.\n%s - %s = %s %s 0",
       act$lab,
       msg,
       exp$lab,
-      act$val - exp$val
+      num_exact(act$val, digits),
+      num_exact(exp$val, digits),
+      num_exact(act$val - exp$val, digits),
+      negated_op
     )
     return(fail(msg, trace_env = trace_env))
   }
@@ -109,3 +119,39 @@ expect_more_than <- function(...) {
   warning("Deprecated: please use `expect_gt()` instead", call. = FALSE)
   expect_gt(...)
 }
+
+
+# Helpers -----------------------------------------------------------------
+
+num_exact <- function(x, digits = 6) {
+  sprintf(paste0("%0.", digits, "f"), x)
+}
+
+min_digits <- function(x, y, tolerance = testthat_tolerance()) {
+  if (is.integer(x) && is.integer(y)) {
+    return(0L)
+  }
+
+  attributes(x) <- NULL
+  attributes(y) <- NULL
+
+  n <- digits(abs(x - y))
+  if (!is.null(tolerance)) {
+    n <- min(n, digits(tolerance))
+  }
+
+  as.integer(n) + 1L
+}
+
+digits <- function(x) {
+  x <- x[!is.na(x) & x != 0]
+  if (length(x) == 0) {
+    return(0)
+  }
+  scale <- -log10(min(x))
+  if (scale <= 0) {
+    0L
+  } else {
+    ceiling(round(scale, digits = 2))
+  }
+}

R/parallel-taskq.R

@@ -78,6 +78,9 @@ task_q <- R6::R6Class(
             private$tasks$state[[i]] <- "ready"
             msg <- NULL
           } else if (msg$code == PROCESS_DONE) {
+            if (!is.null(msg$error)) {
+              private$handle_error(msg, i)
+            }
             private$tasks$state[[i]] <- "ready"
           } else if (msg$code %in% PROCESS_FAILURES) {
             private$handle_error(msg, i)

tests/testthat/_snaps/expect-comparison.md

@@ -0,0 +1,20 @@
+# useful output when numbers are very small
+
+    1.1 * x is not less than `x`.
+    0.0000110 - 0.0000100 = 0.0000010 > 0
+
+---
+
+    `x` is not strictly greater than 1.1 * x.
+    0.0000100 - 0.0000110 = -0.0000010 <= 0
+
+# useful output when difference is zero
+
+    `x` is not strictly less than 100.
+    100.0 - 100.0 = 0.0 >= 0
+
+# useful output when differnce is large
+
+    `x` is not strictly less than 0.001.
+    100.000 - 0.001 = 99.999 >= 0
+

tests/testthat/test-expect-comparison.R

@@ -8,6 +8,22 @@ test_that("basic comparisons work", {
   expect_success(expect_gte(10, 10))
 })
 
+test_that("useful output when numbers are very small", {
+  x <- 1e-5
+  expect_snapshot_failure(expect_lte(1.1 * x, x))
+  expect_snapshot_failure(expect_gt(x, 1.1 * x))
+})
+
+test_that("useful output when difference is zero", {
+  x <- 100
+  expect_snapshot_failure(expect_lt(x, 100))
+})
+
+test_that("useful output when differnce is large", {
+  x <- 100
+  expect_snapshot_failure(expect_lt(x, 0.001))
+})
+
 test_that("comparison result object invisibly", {
   out <- expect_invisible(expect_lt(1, 10))
   expect_equal(out, 1)

tests/testthat/test-parallel-errors.R

@@ -0,0 +1,18 @@
+test_that("error in parallel setup code", {
+  skip_on_covr()
+  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  err <- tryCatch(
+    capture.output(suppressMessages(testthat::test_local(
+      test_path("test-parallel", "syntax-error"),
+      reporter = "summary"
+    ))),
+    error = function(e) e
+  )
+  expect_s3_class(err, "testthat_process_error")
+  # contains test file's name
+  expect_match(conditionMessage(err), "test-error-1.R")
+  # contains original error message
+  expect_match(conditionMessage(err), "unexpected symbol")
+  # contains the text of the syntax error
+  expect_match(conditionMessage(err), "but this")
+})

tests/testthat/test-parallel/syntax-error/DESCRIPTION

@@ -0,0 +1,20 @@
+Package: setup
+Title: What the Package Does (One Line, Title Case)
+Version: 0.0.0.9000
+Authors@R: 
+    person(given = "First",
+           family = "Last",
+           role = c("aut", "cre"),
+           email = "[email protected]",
+           comment = c(ORCID = "YOUR-ORCID-ID"))
+Description: What the package does (one paragraph).
+License: `use_mit_license()`, `use_gpl3_license()` or friends to
+    pick a license
+Encoding: UTF-8
+LazyData: true
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.1.1
+Suggests: 
+    testthat
+Config/testthat/parallel: true
+Config/testthat/edition: 3

tests/testthat/test-parallel/syntax-error/NAMESPACE

@@ -0,0 +1,2 @@
+# Generated by roxygen2: do not edit by hand
+

tests/testthat/test-parallel/syntax-error/tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(ok)
+
+test_check("ok")

tests/testthat/test-parallel/syntax-error/tests/testthat/test-error-1.R

@@ -0,0 +1,5 @@
+test_that("this is good", {
+  expect_equal(2 * 2, 4)
+})
+
+but this is a syntax error!