Merge commit 'fa29578e09f9eeafc6b9822364e29b07c8bd7a8c'

Author: hadley

CLAUDE.md

@@ -18,10 +18,13 @@ General advice:
 - `devtools::test_file("tests/testthat/test-filename.R")` - Run tests in a specific file
 - DO NOT USE `devtools::test_active_file()`
 - `devtools::load_all()` - Load package for development
-- `devtools::document()` - Generate documentation
 - `devtools::check()` - Run R CMD check
 - `devtools::install()` - Install package locally
 
+### Documentation
+
+- Always run `devtools::document()` after changing any roxygen2 docs.
+
 ## Core Architecture
 
 ### Main Components

NAMESPACE

@@ -45,6 +45,7 @@ export(ProgressReporter)
 export(RStudioReporter)
 export(Reporter)
 export(SilentReporter)
+export(SlowReporter)
 export(StopReporter)
 export(SummaryReporter)
 export(TapReporter)

NEWS.md

@@ -1,5 +1,7 @@
 # testthat (development version)
 
+* New `SlowReporter` makes it easier to find the slowest tests in your package. The easiest way to run it is with `devtools::test(reporter = "slow")` (#1466).
+* Power `expect_mapequal()` with `waldo::compare(list_as_map = TRUE)` (#1521).
 * On CRAN, `test_that()` now automatically skips if a package is not installed (#1585). Practically, this means that you no longer need to check that suggested packages are installed. (We don't do this in the tidyverse because we think it has limited payoff, but other styles advise differently.)
 * `expect_snapshot()` no longer skips on CRAN, as that skips the rest of the test. Instead it just returns, neither succeeding nor failing (#1585).
 * Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464)

R/expect-setequal.R

@@ -6,8 +6,9 @@
 #'   (i.e. `y` is a subset of `x`).
 #' * `expect_in(x, y)` tests every element of `x` is in `y`
 #'   (i.e. `x` is a subset of `y`).
-#' * `expect_mapequal(x, y)` tests that `x` and `y` have the same names, and
-#'    that `x[names(y)]` equals `y`.
+#' * `expect_mapequal(x, y)` treats lists as if they are mappings between names
+#'   and values. Concretely, this drops `NULL`s in both objects and sorts
+#'   named components.
 #'
 #' Note that `expect_setequal()` ignores names, and you will be warned if both
 #' `object` and `expected` have them.
@@ -77,37 +78,7 @@ expect_mapequal <- function(object, expected) {
   act <- quasi_label(enquo(object))
   exp <- quasi_label(enquo(expected))
 
-  check_vector(object)
-  check_map_names(object)
-  check_vector(expected)
-  check_map_names(expected)
-
-  # Length-0 vectors are OK whether named or unnamed.
-  if (length(act$val) == 0 && length(exp$val) == 0) {
-    testthat_warn("`object` and `expected` are empty lists")
-    return(pass(act$val))
-  }
-
-  act_nms <- names(act$val)
-  exp_nms <- names(exp$val)
-  if (setequal(act_nms, exp_nms)) {
-    act <- labelled_value(act$val[exp_nms], act$lab)
-    return(expect_waldo_equal_("equal", act, exp))
-  }
-
-  act_miss <- setdiff(exp_nms, act_nms)
-  if (length(act_miss) > 0) {
-    vals <- paste0(encodeString(act_miss, quote = '"'), ", ")
-    return(fail(paste0("Names absent from `object`: ", vals)))
-  }
-
-  exp_miss <- setdiff(act_nms, exp_nms)
-  if (length(exp_miss) > 0) {
-    vals <- paste0(encodeString(exp_miss, quote = '"'), ", ")
-    return(fail(paste0("Names absent from `expected`: ", vals)))
-  }
-
-  pass(act$val)
+  expect_waldo_equal_("equal", act, exp, list_as_map = TRUE)
 }
 
 #' @export

R/reporter-slow.R

@@ -0,0 +1,106 @@
+#' Test reporter: show timings for slow tests
+#'
+#' @description
+#' `SlowReporter` is designed to identify slow tests. It reports the
+#' execution time for each test and can optionally filter out tests that
+#' run faster than a specified threshold (default: 1 second). This reporter
+#' is useful for performance optimization and identifying tests that may
+#' benefit from optimization or parallelization.
+#'
+#' @export
+#' @family reporters
+SlowReporter <- R6::R6Class(
+  "SlowReporter",
+  inherit = Reporter,
+  public = list(
+    min_time = 0.5,
+    test_timings = NULL,
+    current_test_start = NULL,
+    current_file = NULL,
+
+    initialize = function(min_time = 0.5, ...) {
+      super$initialize(...)
+      self$min_time <- min_time
+      self$test_timings <- list()
+    },
+
+    start_reporter = function(context) {
+      self$cat_line(
+        cli::style_bold("Slow tests"),
+        " (showing tests >= ",
+        self$min_time,
+        "s)"
+      )
+      self$cat_line()
+    },
+
+    start_file = function(file) {
+      self$current_file <- file
+    },
+
+    start_test = function(context, test) {
+      self$current_test_start <- proc.time()[[3]]
+    },
+
+    end_test = function(context, test) {
+      if (is.null(self$current_test_start)) {
+        return()
+      }
+
+      time_taken <- proc.time()[[3]] - self$current_test_start
+
+      # Store timing information
+      timing <- list(
+        file = self$current_file,
+        test = test,
+        time = time_taken
+      )
+      self$test_timings[[length(self$test_timings) + 1]] <- timing
+
+      if (time_taken >= self$min_time) {
+        self$show_timing(timing)
+      }
+
+      self$current_test_start <- NULL
+    },
+
+    end_reporter = function() {
+      if (length(self$test_timings) == 0) {
+        return()
+      }
+
+      all_times <- map_dbl(self$test_timings, \(x) x$time)
+      is_slow <- all_times >= self$min_time
+
+      self$cat_line()
+      self$rule(cli::style_bold("Summary"), line = 2)
+      self$cat_line("All tests:  ", sprintf("%.2fs", sum(all_times)))
+      self$cat_line("Slow tests: ", sprintf("%.2fs", sum(all_times[is_slow])))
+
+      if (sum(is_slow) <= 10) {
+        return()
+      }
+
+      # Sort by time descending for summary
+      slowest <- self$test_timings[order(all_times, decreasing = TRUE)]
+
+      self$cat_line()
+      self$rule(cli::style_bold("Slowest tests:"), line = 1)
+
+      # Show top 10 slowest tests
+      for (i in 1:10) {
+        self$show_timing(slowest[[i]])
+      }
+
+      if (length(slowest) > 10) {
+        self$cat_line("... and ", length(slowest) - 10, " more slow tests")
+      }
+
+      self$cat_line()
+    },
+    show_timing = function(timing) {
+      time <- sprintf("%.2fs", timing$time)
+      self$cat_line("[", time, "] ", time, " ", timing$file, ": ", timing$test)
+    }
+  )
+)

R/reporter-timing.R

@@ -0,0 +1,99 @@
+#' Test reporter: show timings for slow tests
+#'
+#' @description
+#' `SlowReporter` is designed to identify slow tests. It reports the
+#' execution time for each test, ignoring tests faster than a specified
+#' threshold (default: 0.5s).
+#'
+#' The easiest way to run it over your package is with
+#' `devtools::test(reporter = "slow")`.
+#'
+#' @export
+#' @family reporters
+SlowReporter <- R6::R6Class(
+  "SlowReporter",
+  inherit = Reporter,
+  public = list(
+    min_time = NA_real_,
+    test_timings = NULL,
+    current_test_start = NULL,
+    current_file = NULL,
+
+    initialize = function(min_time = 0.5, ...) {
+      check_number_decimal(min_time, min = 0)
+
+      super$initialize(...)
+      self$min_time <- min_time
+      self$test_timings <- list()
+    },
+
+    start_file = function(file) {
+      self$current_file <- file
+    },
+
+    start_test = function(context, test) {
+      self$current_test_start <- proc.time()[[3]]
+    },
+
+    end_test = function(context, test) {
+      if (is.null(self$current_test_start)) {
+        return()
+      }
+
+      time_taken <- proc.time()[[3]] - self$current_test_start
+
+      # Store timing information
+      timing <- list(
+        file = self$current_file,
+        test = test,
+        time = time_taken
+      )
+      self$test_timings[[length(self$test_timings) + 1]] <- timing
+
+      if (time_taken >= self$min_time) {
+        self$show_timing(timing)
+      }
+
+      self$current_test_start <- NULL
+    },
+
+    end_reporter = function() {
+      if (length(self$test_timings) == 0) {
+        return()
+      }
+
+      all_times <- map_dbl(self$test_timings, \(x) x$time)
+      is_slow <- all_times >= self$min_time
+
+      self$cat_line()
+      self$rule(cli::style_bold("Summary"), line = 2)
+      self$cat_line("All tests:  ", sprintf("%.2fs", sum(all_times)))
+      self$cat_line("Slow tests: ", sprintf("%.2fs", sum(all_times[is_slow])))
+
+      if (sum(is_slow) <= 10) {
+        return()
+      }
+
+      # Sort by time descending for summary
+      slowest <- self$test_timings[order(all_times, decreasing = TRUE)]
+
+      self$cat_line()
+      self$rule(cli::style_bold("Slowest tests:"), line = 1)
+
+      # Show top 10 slowest tests
+      for (i in 1:10) {
+        self$show_timing(slowest[[i]])
+      }
+
+      if (length(slowest) > 10) {
+        self$cat_line("... and ", length(slowest) - 10, " more slow tests")
+      }
+
+      self$cat_line()
+    },
+    show_timing = function(timing) {
+      time <- sprintf("%.2fs", timing$time)
+      self$cat_line("[", time, "] ", timing$file, ": ", timing$test)
+    }
+  )
+)