✨ Add a shuffle argument ✨

.claude/settings.local.json

@@ -5,7 +5,10 @@
       "Bash(find:*)",
       "Bash(R:*)",
       "Bash(rm:*)",
-      "Bash(air format:*)"
+      "Bash(air format:*)",
+      "Edit(R/**)",
+      "Edit(tests/**)",
+      "Edit(vignettes/**)"
     ],
     "deny": []
   }

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `test_dir()`, `test_file()`, `test_package()`, `test_check()`, `test_local()`, `source_file()` gain a `shuffle` argument uses `sample()` to randomly reorder the top-level expressions in each test file (#1942). This random reordering surfaces dependencies between tests and code outside of any test, as well as dependencies between tests. This helps you find and eliminate unintentional dependencies.
 * `snapshot_accept(test)` now works when the test file name contains `.` (#1669).
 * `local_mock()` and `with_mock()` have been deprecated because they are no longer permitted in R 4.5.
 * `snapshot_review()` now passes `...` on to `shiny::runApp()` (#1928).

R/parallel.R

@@ -41,7 +41,8 @@ test_files_parallel <- function(
   stop_on_failure = FALSE,
   stop_on_warning = FALSE,
   wrap = TRUE, # unused, to match test_files signature
-  load_package = c("none", "installed", "source")
+  load_package = c("none", "installed", "source"),
+  shuffle = FALSE
 ) {
   # TODO: support timeouts. 20-30s for each file by default?
 
@@ -59,7 +60,8 @@ test_files_parallel <- function(
     test_dir = test_dir,
     load_helpers = load_helpers,
     num_workers = num_workers,
-    load_package = load_package
+    load_package = load_package,
+    shuffle = shuffle
   )
 
   withr::with_dir(test_dir, {
@@ -227,7 +229,8 @@ queue_setup <- function(
   test_dir,
   num_workers,
   load_helpers,
-  load_package
+  load_package,
+  shuffle = FALSE
 ) {
   # TODO: observe `load_package`, but the "none" default is not
   # OK for the subprocess, because it'll not have the tested package
@@ -266,9 +269,11 @@ queue_setup <- function(
   })
   queue <- task_q$new(concurrency = num_workers, load_hook = load_hook)
 
-  fun <- transport_fun(function(path) asNamespace("testthat")$queue_task(path))
+  fun <- transport_fun(function(path, shuffle) {
+    asNamespace("testthat")$queue_task(path, shuffle)
+  })
   for (path in test_paths) {
-    queue$push(fun, list(path))
+    queue$push(fun, list(path, shuffle))
   }
 
   queue
@@ -299,7 +304,7 @@ queue_process_setup <- function(
   the$testing_env <- env
 }
 
-queue_task <- function(path) {
+queue_task <- function(path, shuffle = FALSE) {
   withr::local_envvar("TESTTHAT_IS_PARALLEL" = "true")
   snapshotter <- SubprocessSnapshotReporter$new(snap_dir = "_snaps")
   withr::local_options(testthat.snapshotter = snapshotter)
@@ -308,7 +313,10 @@ queue_task <- function(path) {
     snapshotter
   )
   multi <- MultiReporter$new(reporters = reporters)
-  with_reporter(multi, test_one_file(path, env = the$testing_env))
+  with_reporter(
+    multi,
+    test_one_file(path, env = the$testing_env, shuffle = shuffle)
+  )
   NULL
 }
 

R/source.R

@@ -11,6 +11,8 @@
 #' @param chdir Change working directory to `dirname(path)`?
 #' @param wrap Automatically wrap all code within [test_that()]? This ensures
 #'   that all expectations are reported, even if outside a test block.
+#' @param shuffle If `TRUE`, randomly reorder the top-level expressions
+#'   in the file.
 #' @export
 #' @keywords internal
 source_file <- function(
@@ -19,6 +21,7 @@ source_file <- function(
   chdir = TRUE,
   desc = NULL,
   wrap = TRUE,
+  shuffle = FALSE,
   error_call = caller_env()
 ) {
   check_string(path, call = error_call)
@@ -43,6 +46,9 @@ source_file <- function(
   con <- textConnection(lines, encoding = "UTF-8")
   withr::defer(try(close(con), silent = TRUE))
   exprs <- parse(con, n = -1, srcfile = srcfile, encoding = "UTF-8")
+  if (shuffle) {
+    exprs <- sample(exprs)
+  }
   exprs <- filter_desc(exprs, desc, error_call = error_call)
 
   n <- length(exprs)
@@ -119,7 +125,8 @@ source_dir <- function(
   pattern = "\\.[rR]$",
   env = test_env(),
   chdir = TRUE,
-  wrap = TRUE
+  wrap = TRUE,
+  shuffle = FALSE
 ) {
   files <- sort(dir(path, pattern, full.names = TRUE))
 
@@ -130,6 +137,7 @@ source_dir <- function(
       env = env,
       chdir = chdir,
       wrap = wrap,
+      shuffle = shuffle,
       error_call = error_call
     )
   })

R/test-files.R

@@ -52,7 +52,8 @@ test_dir <- function(
   stop_on_warning = FALSE,
   wrap = deprecated(),
   package = NULL,
-  load_package = c("none", "installed", "source")
+  load_package = c("none", "installed", "source"),
+  shuffle = FALSE
 ) {
   load_package <- arg_match(load_package)
 
@@ -94,7 +95,8 @@ test_dir <- function(
     stop_on_failure = stop_on_failure,
     stop_on_warning = stop_on_warning,
     load_package = load_package,
-    parallel = parallel
+    parallel = parallel,
+    shuffle = shuffle
   )
 }
 
@@ -120,6 +122,7 @@ test_file <- function(
   reporter = default_compact_reporter(),
   desc = NULL,
   package = NULL,
+  shuffle = FALSE,
   ...
 ) {
   if (!file.exists(path)) {
@@ -132,6 +135,7 @@ test_file <- function(
     test_paths = basename(path),
     reporter = reporter,
     desc = desc,
+    shuffle = shuffle,
     ...
   )
 }
@@ -149,6 +153,7 @@ test_files <- function(
   wrap = TRUE,
   load_package = c("none", "installed", "source"),
   parallel = FALSE,
+  shuffle = FALSE,
   error_call = caller_env()
 ) {
   if (!isTRUE(wrap)) {
@@ -166,7 +171,8 @@ test_files <- function(
       env = env,
       stop_on_failure = stop_on_failure,
       stop_on_warning = stop_on_warning,
-      load_package = load_package
+      load_package = load_package,
+      shuffle = shuffle
     )
   } else {
     test_files_serial(
@@ -180,6 +186,7 @@ test_files <- function(
       stop_on_warning = stop_on_warning,
       desc = desc,
       load_package = load_package,
+      shuffle = shuffle,
       error_call = error_call
     )
   }
@@ -197,6 +204,7 @@ test_files_serial <- function(
   desc = NULL,
   wrap = TRUE,
   load_package = c("none", "installed", "source"),
+  shuffle = FALSE,
   error_call = caller_env()
 ) {
   # Because load_all() called by test_files_setup_env() will have already
@@ -222,6 +230,7 @@ test_files_serial <- function(
       test_one_file,
       env = env,
       desc = desc,
+      shuffle = shuffle,
       error_call = error_call
     )
   )
@@ -346,6 +355,7 @@ test_one_file <- function(
   path,
   env = test_env(),
   desc = NULL,
+  shuffle = FALSE,
   error_call = caller_env()
 ) {
   reporter <- get_reporter()
@@ -356,6 +366,7 @@ test_one_file <- function(
     path,
     env = env(env),
     desc = desc,
+    shuffle = shuffle,
     error_call = error_call
   )
   reporter$end_context_if_started()

R/test-package.R

@@ -63,7 +63,8 @@ test_local <- function(
   path = ".",
   reporter = NULL,
   ...,
-  load_package = "source"
+  load_package = "source",
+  shuffle = FALSE
 ) {
   package <- pkgload::pkg_name(path)
   test_path <- file.path(pkgload::pkg_path(path), "tests", "testthat")
@@ -74,6 +75,7 @@ test_local <- function(
     package = package,
     reporter = reporter,
     ...,
-    load_package = load_package
+    load_package = load_package,
+    shuffle = shuffle
   )
 }

tests/testthat/_snaps/expect-inheritance.md

@@ -31,14 +31,6 @@
       Error in `expect_s3_class()`:
       ! `exact` must be `TRUE` or `FALSE`, not the string "yes".
 
----
-
-    Code
-      expect_s4_class(factor("a"), 1)
-    Condition
-      Error in `expect_s4_class()`:
-      ! `class` must be a character vector or NA, not the number 1.
-
 # test_s3_class respects class hierarchy
 
     `x` inherits from 'a'/'b' not 'c'.
@@ -47,6 +39,14 @@
 
     `x` inherits from 'a'/'b' not 'c'/'d'.
 
+# expect_s4_class validates its inputs
+
+    Code
+      expect_s4_class(factor("a"), 1)
+    Condition
+      Error in `expect_s4_class()`:
+      ! `class` must be a character vector or NA, not the number 1.
+
 # expect_r6_class generates useful failures
 
     `x` is not an R6 object.

tests/testthat/_snaps/skip.md

@@ -18,15 +18,15 @@
 
     Reason: a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name || a_very_long_argument_name is not TRUE
 
-# skip_if_not_installed() works as expected
+# skip_if_not_installed() works as expected, absence and version
 
     Reason: {doesntexist} is not installed
 
 ---
 
     Reason: Installed testthat is version 3.0.0; but 9999.9999.999 is required
 
----
+# skip_if_not_installed() works as expected, offline
 
     Reason: offline
 

tests/testthat/test-expect-inheritance.R

@@ -82,7 +82,7 @@ test_that("expect_s4_class allows unquoting of first argument", {
 })
 
 
-test_that("expect_s3_class validates its inputs", {
+test_that("expect_s4_class validates its inputs", {
   expect_snapshot(error = TRUE, {
     expect_s4_class(factor("a"), 1)
   })