Merged origin/main into fix/parallel-teardown

gaborcsardi · gaborcsardi · commit f24641d23de9 · 2025-08-13T15:02:30.000+02:00
diff --git a/.github/workflows/claude-code-review.yml b/.github/workflows/claude-code-review.yml
@@ -42,31 +42,13 @@ jobs:
 
           # Direct prompt for automated review (no @claude mention needed)
           direct_prompt: |
-            Please review this pull request and provide feedback on:
-            - Code quality and best practices
-            - Potential bugs or issues
-            - Performance considerations
-            - Security concerns
-            - Test coverage
-            
-            Be constructive and helpful in your feedback.
+            Please review this pull request and MINIMAL provide feedback on
+            potential bugs or issues. Never praise or flatter. Be concise. 
+            Use simple, clear language. If you don't have anything significant
+            to add, just reply LGTM.
 
           # Optional: Use sticky comments to make Claude reuse the same comment on subsequent pushes to the same PR
-          # use_sticky_comment: true
-          
-          # Optional: Customize review based on file types
-          # direct_prompt: |
-          #   Review this PR focusing on:
-          #   - For TypeScript files: Type safety and proper interface usage
-          #   - For API endpoints: Security, input validation, and error handling
-          #   - For React components: Performance, accessibility, and best practices
-          #   - For tests: Coverage, edge cases, and test quality
-          
-          # Optional: Different prompts for different authors
-          # direct_prompt: |
-          #   ${{ github.event.pull_request.author_association == 'FIRST_TIME_CONTRIBUTOR' && 
-          #   'Welcome! Please review this PR from a first-time contributor. Be encouraging and provide detailed explanations for any suggestions.' ||
-          #   'Please provide a thorough code review focusing on our coding standards and best practices.' }}
+          use_sticky_comment: true
           
           # Optional: Add specific tools for running tests or linting
           # allowed_tools: "Bash(npm run test),Bash(npm run lint),Bash(npm run typecheck)"
@@ -75,4 +57,3 @@ jobs:
           # if: |
           #   !contains(github.event.pull_request.title, '[skip-review]') &&
           #   !contains(github.event.pull_request.title, '[WIP]')
-
diff --git a/R/auto-test.R b/R/auto-test.R
@@ -83,7 +83,7 @@ auto_test_package <- function(
   test_path <- normalizePath(file.path(path, "tests", "testthat"))
 
   # Start by loading all code and running all tests
-  withr::local_envvar("NOT_CRAN" = "true")
+  local_assume_not_on_cran()
   pkgload::load_all(path)
   test_dir(
     test_path,
diff --git a/R/local.R b/R/local.R
@@ -190,8 +190,7 @@ local_test_directory <- function(path, package = NULL, .env = parent.frame()) {
 }
 
 local_interactive_reporter <- function(.env = parent.frame()) {
-  # Definitely not on CRAN
-  withr::local_envvar(NOT_CRAN = "true", .local_envir = .env)
+  local_assume_not_on_cran(.env)
   withr::local_options(testthat_interactive = TRUE, .local_envir = .env)
 
   # Use edition from working directory
diff --git a/R/parallel.R b/R/parallel.R
@@ -65,7 +65,7 @@ test_files_parallel <- function(
   )
 
   withr::with_dir(test_dir, {
-    reporters <- test_files_reporter_parallel(reporter)
+    reporters <- test_files_reporter(reporter, "parallel")
     with_reporter(reporters$multi, {
       parallel_updates <- reporter$capabilities$parallel_updates
       if (parallel_updates) {
@@ -83,23 +83,6 @@ test_files_parallel <- function(
   })
 }
 
-test_files_reporter_parallel <- function(reporter, .env = parent.frame()) {
-  lister <- ListReporter$new()
-  snapshotter <- MainprocessSnapshotReporter$new("_snaps")
-  reporters <- list(
-    find_reporter(reporter),
-    lister, # track data
-    snapshotter
-  )
-  withr::local_options(
-    "testthat.snapshotter" = snapshotter,
-    .local_envir = .env
-  )
-  list(
-    multi = MultiReporter$new(reporters = compact(reporters)),
-    list = lister
-  )
-}
 
 default_num_cpus <- function() {
   # Use common option, if set
diff --git a/R/skip.R b/R/skip.R
@@ -190,6 +190,14 @@ local_on_cran <- function(on_cran, frame = caller_env()) {
   withr::local_envvar(NOT_CRAN = tolower(!on_cran), .local_envir = frame)
 }
 
+# Assert that we're not on CRAN, but don't override the user's setting
+local_assume_not_on_cran <- function(frame = caller_env()) {
+  if (Sys.getenv("NOT_CRAN") != "") {
+    return()
+  }
+  withr::local_envvar("NOT_CRAN" = "true", .local_envir = frame)
+}
+
 #' @export
 #' @param os Character vector of one or more operating systems to skip on.
 #'   Supported values are `"windows"`, `"mac"`, `"linux"`, `"solaris"`,
diff --git a/R/snapshot-file-snaps.R b/R/snapshot-file-snaps.R
@@ -39,11 +39,6 @@ FileSnaps <- R6::R6Class(
     },
 
     append = function(test, variant, data) {
-      if (!has_name(self$snaps, variant)) {
-        # Needed for R < 3.6
-        self$snaps[[variant]] <- list()
-      }
-
       self$snaps[[variant]][[test]] <- c(self$snaps[[variant]][[test]], data)
       length(self$snaps[[variant]][[test]])
     },
diff --git a/R/snapshot-reporter.R b/R/snapshot-reporter.R
@@ -140,7 +140,7 @@ SnapshotReporter <- R6::R6Class(
         return()
       }
 
-      # If expectation errors or skips, need to reset remaining snapshots
+      # If expectation errors or skips, need to copy snapshots from old to cur
       if (expectation_error(result) || expectation_skip(result)) {
         self$cur_snaps$reset(self$test, self$old_snaps)
       }
@@ -204,23 +204,19 @@ get_snapshotter <- function() {
 #' @export
 #' @keywords internal
 local_snapshotter <- function(
-  snap_dir = NULL,
+  reporter = SnapshotReporter,
+  snap_dir = "_snaps",
   cleanup = FALSE,
   fail_on_new = NULL,
-  .env = parent.frame()
+  frame = caller_env()
 ) {
-  snap_dir <- snap_dir %||% withr::local_tempdir(.local_envir = .env)
-  reporter <- SnapshotReporter$new(
-    snap_dir = snap_dir,
-    fail_on_new = fail_on_new
-  )
-  if (!identical(cleanup, FALSE)) {
-    cli::cli_warn("{.arg cleanup} is deprecated.")
-  }
+  reporter <- reporter$new(snap_dir = snap_dir, fail_on_new = fail_on_new)
+  withr::local_options("testthat.snapshotter" = reporter, .local_envir = frame)
 
-  withr::local_options(
-    "testthat.snapshotter" = reporter,
-    .local_envir = .env
-  )
   reporter
 }
+
+local_test_snapshotter <- function(snap_dir = NULL, frame = caller_env()) {
+  snap_dir <- snap_dir %||% withr::local_tempdir(.local_envir = frame)
+  local_snapshotter(snap_dir = snap_dir, fail_on_new = FALSE, frame = frame)
+}
diff --git a/R/test-files.R b/R/test-files.R
@@ -221,7 +221,7 @@ test_files_serial <- function(
   local_testing_env(env)
 
   test_files_setup_state(test_dir, test_package, load_helpers, env)
-  reporters <- test_files_reporter(reporter)
+  reporters <- test_files_reporter(reporter, "serial")
 
   with_reporter(
     reporters$multi,
@@ -315,15 +315,30 @@ test_files_setup_state <- function(
   withr::defer(source_test_teardown(".", env), frame) # old school
 }
 
-test_files_reporter <- function(reporter, .env = parent.frame()) {
+test_files_reporter <- function(
+  reporter,
+  mode = c("serial", "parallel"),
+  frame = caller_env()
+) {
+  mode <- arg_match(mode)
+
+  # User selected reporter
+  user <- find_reporter(reporter)
+
+  # Reporter that collect test results
   lister <- ListReporter$new()
-  reporters <- list(
-    find_reporter(reporter),
-    lister, # track data
-    local_snapshotter("_snaps", .env = .env)
-  )
+
+  # Snapshot reporter
+  if (mode == "parallel") {
+    snap_base <- MainprocessSnapshotReporter
+  } else {
+    snap_base <- SnapshotReporter
+  }
+  snap <- local_snapshotter(snap_base, fail_on_new = on_ci(), frame = frame)
+
+  reporters <- compact(list(user, lister, snap))
   list(
-    multi = MultiReporter$new(reporters = compact(reporters)),
+    multi = MultiReporter$new(reporters = reporters),
     list = lister
   )
 }
diff --git a/R/test-package.R b/R/test-package.R
@@ -69,7 +69,7 @@ test_local <- function(
   package <- pkgload::pkg_name(path)
   test_path <- file.path(pkgload::pkg_path(path), "tests", "testthat")
 
-  withr::local_envvar(NOT_CRAN = "true")
+  local_assume_not_on_cran()
   test_dir(
     test_path,
     package = package,
diff --git a/man/local_snapshotter.Rd b/man/local_snapshotter.Rd
diff --git a/tests/testthat/test-parallel-stdout.R b/tests/testthat/test-parallel-stdout.R
@@ -1,32 +1,26 @@
 test_that("stdout/stderr in parallel code", {
   skip_on_covr()
   withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
-  out <- capture.output(suppressMessages(testthat::test_local(
-    test_path("test-parallel", "stdout"),
-    reporter = "summary"
-  )))
-  expect_match(
-    out,
-    "> test-stdout-2.R: This is a message!",
-    fixed = TRUE,
-    all = FALSE
-  )
-  expect_match(out, "test-stdout-3.R:  [1]  1  2  3", fixed = TRUE, all = FALSE)
 
-  out2 <- capture.output(suppressMessages(testthat::test_local(
-    test_path("test-parallel", "stdout"),
-    reporter = "progress"
-  )))
-  expect_match(
-    out2,
-    "> test-stdout-2.R: This is a message!",
-    fixed = TRUE,
-    all = FALSE
-  )
-  expect_match(
-    out2,
-    "test-stdout-3.R:  [1]  1  2  3",
-    fixed = TRUE,
-    all = FALSE
-  )
+  assemble_msgs <- function(txt, test_name) {
+    prefix <- paste0("> ", test_name, ": ")
+    parts <- sub(
+      prefix,
+      "",
+      grep(prefix, out, fixed = TRUE, value = TRUE),
+      fixed = TRUE
+    )
+    paste(parts, collapse = "")
+  }
+
+  for (reporter in c("summary", "progress")) {
+    out <- capture.output(suppressMessages(testthat::test_local(
+      test_path("test-parallel", "stdout"),
+      reporter = reporter
+    )))
+    msg2 <- assemble_msgs(out, "test-stdout-2.R")
+    expect_match(msg2, "This is a message!", fixed = TRUE)
+    msg3 <- assemble_msgs(out, "test-stdout-3.R")
+    expect_match(msg3, "[1]  1  2  3", fixed = TRUE)
+  }
 })
diff --git a/tests/testthat/test-skip.R b/tests/testthat/test-skip.R
@@ -88,6 +88,20 @@ test_that("local_on_cran sets NOT_CRAN", {
   })
 })
 
+test_that("local_assume_not_on_cran() sets NOT_CRAN if not already set", {
+  withr::local_envvar(NOT_CRAN = NA)
+  local({
+    local_assume_not_on_cran()
+    expect_equal(Sys.getenv("NOT_CRAN"), "true")
+  })
+
+  withr::local_envvar(NOT_CRAN = "false")
+  local({
+    local_assume_not_on_cran()
+    expect_equal(Sys.getenv("NOT_CRAN"), "false")
+  })
+})
+
 test_that("skip_on_ci() works as expected", {
   withr::local_envvar(CI = "false")
   expect_no_skip(skip_on_ci())
diff --git a/tests/testthat/test-snapshot-file.R b/tests/testthat/test-snapshot-file.R
@@ -50,7 +50,7 @@ test_that("expect_snapshot_file finds duplicate snapshot files", {
 })
 
 test_that("basic workflow", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
 
   path <- write_tmp_lines(letters)
   # warns on first run
@@ -71,7 +71,7 @@ test_that("basic workflow", {
 })
 
 test_that("can announce snapshot file", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("snapshot-announce", "test")
   announce_snapshot_file(name = "bar.svg")
   expect_equal(snapper$snap_file_seen, "snapshot-announce/bar.svg")
diff --git a/tests/testthat/test-snapshot-reporter.R b/tests/testthat/test-snapshot-reporter.R
@@ -1,5 +1,5 @@
 test_that("can establish local snapshotter for testing", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
 
   snapper$start_file("snapshot-1", "test")
   expect_true(snapper$is_active())
@@ -9,7 +9,7 @@ test_that("can establish local snapshotter for testing", {
 
 test_that("basic workflow", {
   path <- withr::local_tempdir()
-  snapper <- local_snapshotter(path, fail_on_new = FALSE)
+  snapper <- local_test_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-2")
   # output if not active (because test not set here)
   expect_snapshot_output("x") |>
@@ -42,15 +42,15 @@ test_that("defaults to failing on CI", {
   withr::local_envvar(CI = "true")
 
   path <- withr::local_tempdir()
-  snapper <- local_snapshotter(path)
+  snapper <- local_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-2")
   # warns on first creation
   snapper$start_file("snapshot-2", "test")
   expect_error(expect_snapshot_output("x"), "Adding new")
 })
 
 test_that("only create new files for changed variants", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("variants", "test")
   expect_warning(expect_snapshot_output("x"), "Adding new")
   expect_warning(expect_snapshot_output("x", variant = "a"), "Adding new")
@@ -86,7 +86,7 @@ test_that("only create new files for changed variants", {
 })
 
 test_that("only reverting change in variant deletes .new", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("v", "test")
   expect_warning(expect_snapshot_output("x", variant = "a"), "Adding new")
   expect_warning(expect_snapshot_output("x", variant = "b"), "Adding new")
@@ -109,7 +109,7 @@ test_that("only reverting change in variant deletes .new", {
 
 test_that("removing tests removes snap file", {
   path <- withr::local_tempdir()
-  snapper <- local_snapshotter(path, fail_on_new = FALSE)
+  snapper <- local_test_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-3", "test")
   expect_warning(expect_snapshot_output("x"), "Adding new")
   snapper$end_file()
@@ -121,7 +121,7 @@ test_that("removing tests removes snap file", {
 })
 
 test_that("errors in test doesn't change snapshot", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
 
   # First run
   snapper$start_file("snapshot-5", "test")
diff --git a/tests/testthat/test-snapshot-value.R b/tests/testthat/test-snapshot-value.R
@@ -32,7 +32,7 @@ test_that("reparse handles common cases", {
 })
 
 test_that("errors if can't roundtrip", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("snapshot-4", "test")
 
   expect_error(expect_snapshot_value(NULL), "safely serialized")

Original file line number	Diff line number	Diff line change
`@@ -190,8 +190,7 @@ local_test_directory <- function(path, package = NULL, .env = parent.frame()) {`
`190`	`190`	`}`
`191`	`191`
`192`	`192`	`local_interactive_reporter <- function(.env = parent.frame()) {`
`193`		`- # Definitely not on CRAN`
`194`		`- withr::local_envvar(NOT_CRAN = "true", .local_envir = .env)`
	`193`	`+ local_assume_not_on_cran(.env)`
`195`	`194`	`withr::local_options(testthat_interactive = TRUE, .local_envir = .env)`
`196`	`195`
`197`	`196`	`# Use edition from working directory`