From 88032b94da3431fff4cd5648a8cc2f3dc17231a6 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 09:27:36 +0200
Subject: [PATCH 01/16] rename `validate_facets()` to `check_facets()`

---
 R/facet-.R                      | 6 +++---
 tests/testthat/_snaps/facet-.md | 2 +-
 tests/testthat/test-facet-.R    | 6 +++---
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/R/facet-.R b/R/facet-.R
index 2e349f6f97..39dc369a64 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -399,7 +399,7 @@ df.grid <- function(a, b) {
 # facetting variables.
 
 as_facets_list <- function(x) {
-  x <- validate_facets(x)
+  check_facet_class(x)
   if (is_quosures(x)) {
     x <- quos_auto_name(x)
     return(list(x))
@@ -436,7 +436,7 @@ as_facets_list <- function(x) {
   x
 }
 
-validate_facets <- function(x) {
+check_facet_class <- function(x) {
   if (inherits(x, "uneval")) {
     cli::cli_abort("Please use {.fn vars} to supply facet variables.")
   }
@@ -448,7 +448,7 @@ validate_facets <- function(x) {
       "i" = "Did you use {.code %>%} or {.code |>} instead of {.code +}?"
     ))
   }
-  x
+  invisible()
 }
 
 
diff --git a/tests/testthat/_snaps/facet-.md b/tests/testthat/_snaps/facet-.md
index 2efa86bc64..5cf9de677a 100644
--- a/tests/testthat/_snaps/facet-.md
+++ b/tests/testthat/_snaps/facet-.md
@@ -40,7 +40,7 @@
 
     Faceting variables must have at least one value.
 
-# validate_facets() provide meaningful errors
+# check_facet_class() provide meaningful errors
 
     Please use `vars()` to supply facet variables.
 
diff --git a/tests/testthat/test-facet-.R b/tests/testthat/test-facet-.R
index 9e536798a8..c885d90d91 100644
--- a/tests/testthat/test-facet-.R
+++ b/tests/testthat/test-facet-.R
@@ -469,9 +469,9 @@ test_that("eval_facet() is tolerant for missing columns (#2963)", {
   )
 })
 
-test_that("validate_facets() provide meaningful errors", {
-  expect_snapshot_error(validate_facets(aes(var)))
-  expect_snapshot_error(validate_facets(ggplot()))
+test_that("check_facet_class() provide meaningful errors", {
+  expect_snapshot_error(check_facet_class(aes(var)))
+  expect_snapshot_error(check_facet_class(ggplot()))
 })
 
 test_that("check_layout() throws meaningful errors", {

From 0d51dd67d94c7bbd2bb673d1be03e8bcaa056432 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 09:58:01 +0200
Subject: [PATCH 02/16] write prevalidation/postvalidation as checks

---
 R/fortify.R | 46 +++++++++++++++++++++++++++++-----------------
 1 file changed, 29 insertions(+), 17 deletions(-)

diff --git a/R/fortify.R b/R/fortify.R
index 5b5b7c5171..607ee00d56 100644
--- a/R/fortify.R
+++ b/R/fortify.R
@@ -44,34 +44,46 @@ fortify.grouped_df <- function(model, data, ...) {
 # There are a lot of ways that dim(), colnames(), or as.data.frame() could
 # do non-sensical things (they are not even guaranteed to work!) hence the
 # paranoid mode.
-.prevalidate_data_frame_like_object <- function(data) {
+check_data_frame_like <- function(data) {
   orig_dims <- dim(data)
-  if (!vec_is(orig_dims, integer(), size=2))
-    cli::cli_abort(paste0("{.code dim(data)} must return ",
-                          "an {.cls integer} of length 2."))
-  if (anyNA(orig_dims) || any(orig_dims < 0))  # extra-paranoid mode
-    cli::cli_abort(paste0("{.code dim(data)} can't have {.code NA}s ",
-                          "or negative values."))
+  if (!vec_is(orig_dims, integer(), size = 2)) {
+    cli::cli_abort(
+      "{.code dim(data)} must return an {.cls integer} of length 2."
+    )
+  }
+  if (anyNA(orig_dims) || any(orig_dims < 0)) { # extra-paranoid mode
+    cli::cli_abort(
+      "{.code dim(data)} can't have {.code NA}s or negative values."
+    )
+  }
   orig_colnames <- colnames(data)
-  if (!vec_is(orig_colnames, character(), size = ncol(data)))
-    cli::cli_abort(paste0("{.code colnames(data)} must return a ",
-                          "{.cls character} of length {.code ncol(data)}."))
+  if (!vec_is(orig_colnames, character(), size = ncol(data))) {
+    cli::cli_abort(
+      "{.code colnames(data)} must return a {.cls character} of length {.code ncol(data)}."
+    )
+  }
+  invisible()
 }
-.postvalidate_data_frame_like_object <- function(df, data) {
+check_data_frame_conversion <- function(new, old) {
   msg0 <- "{.code as.data.frame(data)} must "
-  if (!is.data.frame(df))
+  if (!is.data.frame(new)) {
     cli::cli_abort(paste0(msg0, "return a {.cls data.frame}."))
-  if (!identical(dim(df), dim(data)))
+  }
+  if (!identical(dim(new), dim(old))) {
     cli::cli_abort(paste0(msg0, "preserve dimensions."))
-  if (!identical(colnames(df), colnames(data)))
+  }
+  if (!identical(colnames(new), colnames(old))) {
     cli::cli_abort(paste0(msg0, "preserve column names."))
+  }
+  invisible()
 }
 validate_as_data_frame <- function(data) {
-  if (is.data.frame(data))
+  if (is.data.frame(data)) {
     return(data)
-  .prevalidate_data_frame_like_object(data)
+  }
+  check_data_frame_like(data)
   df <- as.data.frame(data)
-  .postvalidate_data_frame_like_object(df, data)
+  check_data_frame_conversion(df, data)
   df
 }
 

From 64e0720635984b7e8084a984301b251620317923 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 10:32:28 +0200
Subject: [PATCH 03/16] more responsibility for `check_nondata_cols()`

---
 R/geom-.R                      | 16 +++++----------
 R/layer.R                      | 36 ++++++++++++----------------------
 R/utilities.R                  | 34 +++++++++++++++++++++-----------
 tests/testthat/_snaps/geom-.md |  8 ++++----
 tests/testthat/_snaps/layer.md | 20 +++++++++----------
 5 files changed, 54 insertions(+), 60 deletions(-)

diff --git a/R/geom-.R b/R/geom-.R
index 5b6a2af09d..c864c234de 100644
--- a/R/geom-.R
+++ b/R/geom-.R
@@ -165,17 +165,11 @@ Geom <- ggproto("Geom",
       modified_aes <- lapply(substitute_aes(modifiers),  eval_tidy, mask, env)
 
       # Check that all output are valid data
-      nondata_modified <- check_nondata_cols(modified_aes)
-      if (length(nondata_modified) > 0) {
-        issues <- paste0("{.code ", nondata_modified, " = ", as_label(modifiers[[nondata_modified]]), "}")
-        names(issues) <- rep("x", length(issues))
-        cli::cli_abort(c(
-          "Aesthetic modifiers returned invalid values",
-          "x" = "The following mappings are invalid",
-          issues,
-          "i" = "Did you map the modifier in the wrong layer?"
-        ))
-      }
+      check_nondata_cols(
+        modified_aes, modifiers,
+        problem = "Aesthetic modifiers returned invalid values.",
+        hint    = "Did you map the modifier in the wrong layer?"
+      )
 
       names(modified_aes) <- names(rename_aes(modifiers))
 
diff --git a/R/layer.R b/R/layer.R
index 8acb438c9e..cb72c5ec13 100644
--- a/R/layer.R
+++ b/R/layer.R
@@ -58,8 +58,8 @@
 #'   `NA`, the default, includes if any aesthetics are mapped.
 #'   `FALSE` never includes, and `TRUE` always includes.
 #'   It can also be a named logical vector to finely select the aesthetics to
-#'   display. To include legend keys for all levels, even 
-#'   when no data exists, use `TRUE`.  If `NA`, all levels are shown in legend, 
+#'   display. To include legend keys for all levels, even
+#'   when no data exists, use `TRUE`.  If `NA`, all levels are shown in legend,
 #'   but unobserved levels are omitted.
 #' @param inherit.aes If `FALSE`, overrides the default aesthetics,
 #'   rather than combining with them. This is most useful for helper functions
@@ -313,17 +313,11 @@ Layer <- ggproto("Layer", NULL,
     warn_for_aes_extract_usage(aesthetics, data[setdiff(names(data), "PANEL")])
 
     # Check aesthetic values
-    nondata_cols <- check_nondata_cols(evaled)
-    if (length(nondata_cols) > 0) {
-      issues <- paste0("{.code ", nondata_cols, " = ", as_label(aesthetics[[nondata_cols]]), "}")
-      names(issues) <- rep("x", length(issues))
-      cli::cli_abort(c(
-        "Aesthetics are not valid data columns.",
-        "x" = "The following aesthetics are invalid:",
-        issues,
-        "i" = "Did you mistype the name of a data column or forget to add {.fn after_stat}?"
-      ))
-    }
+    check_nondata_cols(
+      evaled, aesthetics,
+      problem = "Aesthetics are not valid data columns.",
+      hint    = "Did you mistype the name of a data column or forget to add {.fn after_stat}?"
+    )
 
     n <- nrow(data)
     aes_n <- lengths(evaled)
@@ -395,17 +389,11 @@ Layer <- ggproto("Layer", NULL,
     stat_data <- lapply(new, eval_tidy, mask, env)
 
     # Check that all columns in aesthetic stats are valid data
-    nondata_stat_cols <- check_nondata_cols(stat_data)
-    if (length(nondata_stat_cols) > 0) {
-      issues <- paste0("{.code ", nondata_stat_cols, " = ", as_label(aesthetics[[nondata_stat_cols]]), "}")
-      names(issues) <- rep("x", length(issues))
-      cli::cli_abort(c(
-        "Aesthetics must be valid computed stats.",
-        "x" = "The following aesthetics are invalid:",
-        issues,
-        "i" = "Did you map your stat in the wrong layer?"
-      ))
-    }
+    check_nondata_cols(
+      stat_data, aesthetics,
+      problem = "Aesthetics must be valid computed stats.",
+      hint    = "Did you map your stat in the wrong layer?"
+    )
 
     names(stat_data) <- names(new)
     stat_data <- data_frame0(!!!compact(stat_data))
diff --git a/R/utilities.R b/R/utilities.R
index 56325e83d9..7012e7800a 100644
--- a/R/utilities.R
+++ b/R/utilities.R
@@ -300,17 +300,29 @@ is.discrete <- function(x) {
   is.factor(x) || is.character(x) || is.logical(x)
 }
 
-# This function checks that all columns of a dataframe `x` are data and returns
-# the names of any columns that are not.
-# We define "data" as atomic types or lists, not functions or otherwise.
-# The `inherits(x, "Vector")` check is for checking S4 classes from Bioconductor
-# and whether they can be expected to follow behavior typical of vectors. See
-# also #3835
-check_nondata_cols <- function(x) {
-  idx <- (vapply(x, function(x) {
-    is.null(x) || rlang::is_vector(x) || inherits(x, "Vector")
-  }, logical(1)))
-  names(x)[which(!idx)]
+check_nondata_cols <- function(data, mapping, problem = NULL, hint = NULL) {
+  # We define "data" as atomic types or lists, not functions or otherwise.
+  # The `inherits(x, "Vector")` check is for checking S4 classes from Bioconductor
+  # and whether they can be expected to follow behaviour typical of vectors. See
+  # also #3835
+  invalid <- which(!vapply(
+    data, FUN.VALUE = logical(1),
+    function(x) is.null(x) || rlang::is_vector(x) || inherits(x, "Vector")
+  ))
+  invalid <- names(data)[invalid]
+
+  if (length(invalid) < 1) {
+    return(invisible())
+  }
+
+  mapping <- vapply(mapping[invalid], as_label, character(1))
+  issues <- paste0("{.code ", invalid, " = ", mapping, "}")
+  names(issues) <- rep("*", length(issues))
+  issues <- c(x = "The following aesthetics are invalid:", issues)
+
+  # Using 'call = NULL' here because `by_layer()` does a good job of indicating
+  # the origin of the error
+  cli::cli_abort(c(problem, issues, i = hint), call = NULL)
 }
 
 compact <- function(x) {
diff --git a/tests/testthat/_snaps/geom-.md b/tests/testthat/_snaps/geom-.md
index 0eae2d74ba..b0ca0c7e85 100644
--- a/tests/testthat/_snaps/geom-.md
+++ b/tests/testthat/_snaps/geom-.md
@@ -2,10 +2,10 @@
 
     Problem while setting up geom aesthetics.
     i Error occurred in the 1st layer.
-    Caused by error in `use_defaults()`:
-    ! Aesthetic modifiers returned invalid values
-    x The following mappings are invalid
-    x `colour = after_scale(data)`
+    Caused by error:
+    ! Aesthetic modifiers returned invalid values.
+    x The following aesthetics are invalid:
+    * `colour = after_scale(data)`
     i Did you map the modifier in the wrong layer?
 
 ---
diff --git a/tests/testthat/_snaps/layer.md b/tests/testthat/_snaps/layer.md
index d95e11bed6..529483710e 100644
--- a/tests/testthat/_snaps/layer.md
+++ b/tests/testthat/_snaps/layer.md
@@ -31,42 +31,42 @@
 
     Problem while computing aesthetics.
     i Error occurred in the 1st layer.
-    Caused by error in `compute_aesthetics()`:
+    Caused by error:
     ! Aesthetics are not valid data columns.
     x The following aesthetics are invalid:
-    x `fill = data`
+    * `fill = data`
     i Did you mistype the name of a data column or forget to add `after_stat()`?
 
 ---
 
     Problem while mapping stat to aesthetics.
     i Error occurred in the 1st layer.
-    Caused by error in `map_statistic()`:
+    Caused by error:
     ! Aesthetics must be valid computed stats.
     x The following aesthetics are invalid:
-    x `fill = after_stat(data)`
+    * `fill = after_stat(data)`
     i Did you map your stat in the wrong layer?
 
 # function aesthetics are wrapped with after_stat()
 
     Problem while computing aesthetics.
     i Error occurred in the 1st layer.
-    Caused by error in `compute_aesthetics()`:
+    Caused by error:
     ! Aesthetics are not valid data columns.
     x The following aesthetics are invalid:
-    x `colour = NULL`
-    x `fill = NULL`
+    * `colour = density`
+    * `fill = density`
     i Did you mistype the name of a data column or forget to add `after_stat()`?
 
 # computed stats are in appropriate layer
 
     Problem while mapping stat to aesthetics.
     i Error occurred in the 1st layer.
-    Caused by error in `map_statistic()`:
+    Caused by error:
     ! Aesthetics must be valid computed stats.
     x The following aesthetics are invalid:
-    x `colour = NULL`
-    x `fill = NULL`
+    * `colour = after_stat(density)`
+    * `fill = after_stat(density)`
     i Did you map your stat in the wrong layer?
 
 # layer reports the error with correct index etc

From da57ff97f81310eff99ca210c09d81df40526af5 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 10:58:13 +0200
Subject: [PATCH 04/16] `check_subclass()` is actually validator

---
 R/geom-defaults.R              |  4 ++--
 R/guide-.R                     |  2 +-
 R/layer.R                      | 31 +++++++++++++------------------
 R/utilities-help.R             |  4 ++--
 tests/testthat/_snaps/layer.md |  6 +++---
 tests/testthat/test-layer.R    |  4 ++--
 6 files changed, 23 insertions(+), 28 deletions(-)

diff --git a/R/geom-defaults.R b/R/geom-defaults.R
index 65974f841a..6a53cd5cfe 100644
--- a/R/geom-defaults.R
+++ b/R/geom-defaults.R
@@ -96,7 +96,7 @@ get_geom_defaults <- function(geom, theme = theme_get()) {
     return(data)
   }
   if (is.character(geom)) {
-    geom <- check_subclass(geom, "Geom")
+    geom <- validate_subclass(geom, "Geom")
   }
   if (inherits(geom, "Geom")) {
     out <- geom$use_defaults(data = NULL, theme = theme)
@@ -116,7 +116,7 @@ reset_stat_defaults <- function() reset_defaults("stat")
 cache_defaults <- new_environment()
 
 update_defaults <- function(name, subclass, new, env = parent.frame()) {
-  obj   <- check_subclass(name, subclass, env = env)
+  obj   <- validate_subclass(name, subclass, env = env)
   index <- snake_class(obj)
 
   if (is.null(new)) { # Reset from cache
diff --git a/R/guide-.R b/R/guide-.R
index 4cb77ee7bb..17558b83f9 100644
--- a/R/guide-.R
+++ b/R/guide-.R
@@ -19,7 +19,7 @@ NULL
 new_guide <- function(..., available_aes = "any", super) {
 
   pf <- parent.frame()
-  super <- check_subclass(super, "Guide", env = pf)
+  super <- validate_subclass(super, "Guide", env = pf)
 
   args <- list2(...)
 
diff --git a/R/layer.R b/R/layer.R
index cb72c5ec13..83e9754322 100644
--- a/R/layer.R
+++ b/R/layer.R
@@ -101,12 +101,6 @@ layer <- function(geom = NULL, stat = NULL,
                   show.legend = NA, key_glyph = NULL, layer_class = Layer) {
   call_env <- caller_env()
   user_env <- caller_env(2)
-  if (is.null(geom))
-    cli::cli_abort("Can't create layer without a geom.", call = call_env)
-  if (is.null(stat))
-    cli::cli_abort("Can't create layer without a stat.", call = call_env)
-  if (is.null(position))
-    cli::cli_abort("Can't create layer without a position.", call = call_env)
 
   # Handle show_guide/show.legend
   if (!is.null(params$show_guide)) {
@@ -125,9 +119,9 @@ layer <- function(geom = NULL, stat = NULL,
 
   data <- fortify(data)
 
-  geom <- check_subclass(geom, "Geom", env = parent.frame(), call = call_env)
-  stat <- check_subclass(stat, "Stat", env = parent.frame(), call = call_env)
-  position <- check_subclass(position, "Position", env = parent.frame(), call = call_env)
+  geom <- validate_subclass(geom, "Geom", env = parent.frame(), call = call_env)
+  stat <- validate_subclass(stat, "Stat", env = parent.frame(), call = call_env)
+  position <- validate_subclass(position, "Position", env = parent.frame(), call = call_env)
 
   # Special case for na.rm parameter needed by all layers
   params$na.rm <- params$na.rm %||% FALSE
@@ -458,24 +452,25 @@ Layer <- ggproto("Layer", NULL,
 
 is.layer <- function(x) inherits(x, "Layer")
 
-check_subclass <- function(x, subclass,
-                           argname = to_lower_ascii(subclass),
-                           env = parent.frame(),
-                           call = caller_env()) {
+validate_subclass <- function(x, subclass,
+                              argname = to_lower_ascii(subclass),
+                              x_arg = caller_arg(x),
+                              env = parent.frame(),
+                              call = caller_env()) {
   if (inherits(x, subclass)) {
-    x
+    return(x)
   } else if (is_scalar_character(x)) {
     name <- paste0(subclass, camelize(x, first = TRUE))
     obj <- find_global(name, env = env)
 
     if (is.null(obj) || !inherits(obj, subclass)) {
       cli::cli_abort("Can't find {argname} called {.val {x}}.", call = call)
-    } else {
-      obj
     }
-  } else {
-    stop_input_type(x, as_cli("either a string or a {.cls {subclass}} object"))
+    return(obj)
+  } else if (is.null(x)) {
+    cli::cli_abort("The {.arg {x_arg}} argument cannot be empty.", call = call)
   }
+  stop_input_type(x, as_cli("either a string or a {.cls {subclass}} object"))
 }
 
 # helper function to adjust the draw_key slot of a geom
diff --git a/R/utilities-help.R b/R/utilities-help.R
index 87f5419612..22bddc7dcd 100644
--- a/R/utilities-help.R
+++ b/R/utilities-help.R
@@ -2,8 +2,8 @@
 # Geoms and there's some difference among their aesthetics).
 rd_aesthetics <- function(type, name, extra_note = NULL) {
   obj <- switch(type,
-    geom = check_subclass(name, "Geom", env = globalenv()),
-    stat = check_subclass(name, "Stat", env = globalenv())
+    geom = validate_subclass(name, "Geom", env = globalenv()),
+    stat = validate_subclass(name, "Stat", env = globalenv())
   )
   aes <- rd_aesthetics_item(obj)
 
diff --git a/tests/testthat/_snaps/layer.md b/tests/testthat/_snaps/layer.md
index 529483710e..3f86d0f2c4 100644
--- a/tests/testthat/_snaps/layer.md
+++ b/tests/testthat/_snaps/layer.md
@@ -1,14 +1,14 @@
 # layer() checks its input
 
-    Can't create layer without a geom.
+    The `geom` argument cannot be empty.
 
 ---
 
-    Can't create layer without a stat.
+    The `stat` argument cannot be empty.
 
 ---
 
-    Can't create layer without a position.
+    The `position` argument cannot be empty.
 
 ---
 
diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R
index 51f0cd9eee..c6073b027c 100644
--- a/tests/testthat/test-layer.R
+++ b/tests/testthat/test-layer.R
@@ -8,8 +8,8 @@ test_that("layer() checks its input", {
   expect_snapshot_error(layer("point", "identity", mapping = 1:4, position = "identity"))
   expect_snapshot_error(layer("point", "identity", mapping = ggplot(), position = "identity"))
 
-  expect_snapshot_error(check_subclass("test", "geom"))
-  expect_snapshot_error(check_subclass(environment(), "geom"))
+  expect_snapshot_error(validate_subclass("test", "geom"))
+  expect_snapshot_error(validate_subclass(environment(), "geom"))
 })
 
 test_that("aesthetics go in aes_params", {

From a1d8b5aed71a043a83e57c24e8df140f476b1cc9 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 13:32:14 +0200
Subject: [PATCH 05/16] path checker is validator

---
 R/save.R | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/save.R b/R/save.R
index acc4176162..321f91dfda 100644
--- a/R/save.R
+++ b/R/save.R
@@ -95,7 +95,7 @@ ggsave <- function(filename, plot = get_last_plot(),
                    dpi = 300, limitsize = TRUE, bg = NULL,
                    create.dir = FALSE,
                    ...) {
-  filename <- check_path(path, filename, create.dir)
+  filename <- validate_path(path, filename, create.dir)
 
   dpi <- parse_dpi(dpi)
   dev <- plot_dev(device, filename, dpi = dpi)
@@ -116,8 +116,8 @@ ggsave <- function(filename, plot = get_last_plot(),
   invisible(filename)
 }
 
-check_path <- function(path, filename, create.dir,
-                       call = caller_env()) {
+validate_path <- function(path, filename, create.dir,
+                          call = caller_env()) {
 
   if (length(filename) > 1 && is.character(filename)) {
     cli::cli_warn(c(

From 690255b3666fbac0d9db6cb891b4c01fa78cbf50 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 13:36:25 +0200
Subject: [PATCH 06/16] plot_dev is a validator

---
 R/save.R                     |  4 ++--
 tests/testthat/test-ggsave.R | 12 ++++++------
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/R/save.R b/R/save.R
index 321f91dfda..89a435a22f 100644
--- a/R/save.R
+++ b/R/save.R
@@ -98,7 +98,7 @@ ggsave <- function(filename, plot = get_last_plot(),
   filename <- validate_path(path, filename, create.dir)
 
   dpi <- parse_dpi(dpi)
-  dev <- plot_dev(device, filename, dpi = dpi)
+  dev <- validate_device(device, filename, dpi = dpi)
   dim <- plot_dim(c(width, height), scale = scale, units = units,
     limitsize = limitsize, dpi = dpi)
 
@@ -235,7 +235,7 @@ plot_dim <- function(dim = c(NA, NA), scale = 1, units = "in",
   dim
 }
 
-plot_dev <- function(device, filename = NULL, dpi = 300, call = caller_env()) {
+validate_device <- function(device, filename = NULL, dpi = 300, call = caller_env()) {
   force(filename)
   force(dpi)
 
diff --git a/tests/testthat/test-ggsave.R b/tests/testthat/test-ggsave.R
index a5d7a5283c..b4fa978751 100644
--- a/tests/testthat/test-ggsave.R
+++ b/tests/testthat/test-ggsave.R
@@ -125,19 +125,19 @@ test_that("scale multiplies height & width", {
 # plot_dev ---------------------------------------------------------------------
 
 test_that("unknown device triggers error", {
-  expect_snapshot_error(plot_dev(1))
-  expect_error(plot_dev("xyz"), "Unknown graphics device")
-  expect_error(plot_dev(NULL, "test.xyz"), "Unknown graphics device")
+  expect_snapshot_error(validate_device(1))
+  expect_error(validate_device("xyz"), "Unknown graphics device")
+  expect_error(validate_device(NULL, "test.xyz"), "Unknown graphics device")
 })
 
 
 test_that("text converted to function", {
-  expect_identical(body(plot_dev("png"))[[1]], quote(png_dev))
-  expect_identical(body(plot_dev("pdf"))[[1]], quote(grDevices::pdf))
+  expect_identical(body(validate_device("png"))[[1]], quote(png_dev))
+  expect_identical(body(validate_device("pdf"))[[1]], quote(grDevices::pdf))
 })
 
 test_that("if device is NULL, guess from extension", {
-  expect_identical(body(plot_dev(NULL, "test.png"))[[1]], quote(png_dev))
+  expect_identical(body(validate_device(NULL, "test.png"))[[1]], quote(png_dev))
 })
 
 # parse_dpi ---------------------------------------------------------------

From 7b7104576f094faf0cc9d2d6b69db8c95e097056 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 13:39:42 +0200
Subject: [PATCH 07/16] `check_breaks_labels()` has no return value

---
 R/scale-.R                                 | 9 +++------
 tests/testthat/test-scales-breaks-labels.R | 4 ++--
 2 files changed, 5 insertions(+), 8 deletions(-)

diff --git a/R/scale-.R b/R/scale-.R
index fd0bbd444f..31bced1954 100644
--- a/R/scale-.R
+++ b/R/scale-.R
@@ -608,11 +608,8 @@ Scale <- ggproto("Scale", NULL,
 )
 
 check_breaks_labels <- function(breaks, labels, call = NULL) {
-  if (is.null(breaks)) {
-    return(TRUE)
-  }
-  if (is.null(labels)) {
-    return(TRUE)
+  if (is.null(breaks) || is.null(labels)) {
+    return(invisible())
   }
 
   bad_labels <- is.atomic(breaks) && is.atomic(labels) &&
@@ -624,7 +621,7 @@ check_breaks_labels <- function(breaks, labels, call = NULL) {
     )
   }
 
-  TRUE
+  invisible()
 }
 
 default_transform <- function(self, x) {
diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R
index c3a314cacc..d9ef3ea6d6 100644
--- a/tests/testthat/test-scales-breaks-labels.R
+++ b/tests/testthat/test-scales-breaks-labels.R
@@ -14,8 +14,8 @@ test_that("labels match breaks", {
 })
 
 test_that("labels don't have to match null breaks", {
-  expect_true(check_breaks_labels(breaks = 1:3, labels = NULL))
-  expect_true(check_breaks_labels(breaks = NULL, labels = 1:2))
+  expect_silent(check_breaks_labels(breaks = 1:3, labels = NULL))
+  expect_silent(check_breaks_labels(breaks = NULL, labels = 1:2))
 })
 
 test_that("labels don't have extra spaces", {

From e59383339231018ecd63972ec690e940fe5b45df Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 13:48:57 +0200
Subject: [PATCH 08/16] make `check_scale_type()` consistent

---
 R/scale-colour.R | 102 ++++++++++++++++++++++++++---------------------
 R/scale-hue.R    |  43 +++++++++-----------
 2 files changed, 75 insertions(+), 70 deletions(-)

diff --git a/R/scale-colour.R b/R/scale-colour.R
index 71255e2033..cf6f8f4d88 100644
--- a/R/scale-colour.R
+++ b/R/scale-colour.R
@@ -87,8 +87,11 @@ scale_colour_continuous <- function(...,
     if (!any(c("...", "call") %in% fn_fmls_names(type))) {
       args$call <- NULL
     }
-    check_scale_type(exec(type, !!!args), "scale_colour_continuous", "colour")
-  } else if (identical(type, "gradient")) {
+    scale <- exec(type, !!!args)
+    check_scale_type(scale, "scale_colour_continuous", "colour")
+    return(scale)
+  }
+  if (identical(type, "gradient")) {
     exec(scale_colour_gradient, !!!args)
   } else if (identical(type, "viridis")) {
     exec(scale_colour_viridis_c, !!!args)
@@ -112,8 +115,11 @@ scale_fill_continuous <- function(...,
     if (!any(c("...", "call") %in% fn_fmls_names(type))) {
       args$call <- NULL
     }
-    check_scale_type(exec(type, !!!args), "scale_fill_continuous", "fill")
-  } else if (identical(type, "gradient")) {
+    scale <- exec(type, !!!args)
+    check_scale_type(scale, "scale_fill_continuous", "fill")
+    return(scale)
+  }
+  if (identical(type, "gradient")) {
     exec(scale_fill_gradient, !!!args)
   } else if (identical(type, "viridis")) {
     exec(scale_fill_viridis_c, !!!args)
@@ -135,27 +141,29 @@ scale_colour_binned <- function(...,
     if (!any(c("...", "call") %in% fn_fmls_names(type))) {
       args$call <- NULL
     }
-    check_scale_type(exec(type, !!!args), "scale_colour_binned", "colour")
-  } else {
-    type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient")
-    # don't use fallback from scale_colour_continuous() if it is
-    # a function, since that would change the type of the color
-    # scale from binned to continuous
-    if (is.function(type_fallback)) {
-      type_fallback <- "gradient"
-    }
-    type <- type %||% type_fallback
+    scale <- exec(type, !!!args)
+    check_scale_type(scale, "scale_colour_binned", "colour")
+    return(scale)
+  }
 
-    if (identical(type, "gradient")) {
-      exec(scale_colour_steps, !!!args)
-    } else if (identical(type, "viridis")) {
-      exec(scale_colour_viridis_b, !!!args)
-    } else {
-      cli::cli_abort(c(
-        "Unknown scale type: {.val {type}}",
-        "i" = "Use either {.val gradient} or {.val viridis}."
-      ))
-    }
+  type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient")
+  # don't use fallback from scale_colour_continuous() if it is
+  # a function, since that would change the type of the color
+  # scale from binned to continuous
+  if (is.function(type_fallback)) {
+    type_fallback <- "gradient"
+  }
+  type <- type %||% type_fallback
+
+  if (identical(type, "gradient")) {
+    exec(scale_colour_steps, !!!args)
+  } else if (identical(type, "viridis")) {
+    exec(scale_colour_viridis_b, !!!args)
+  } else {
+    cli::cli_abort(c(
+      "Unknown scale type: {.val {type}}",
+      "i" = "Use either {.val gradient} or {.val viridis}."
+    ))
   }
 }
 
@@ -165,31 +173,34 @@ scale_fill_binned <- function(...,
                               type = getOption("ggplot2.binned.fill")) {
   args <- list2(...)
   args$call <- args$call %||% current_call()
+
   if (is.function(type)) {
     if (!any(c("...", "call") %in% fn_fmls_names(type))) {
       args$call <- NULL
     }
-    check_scale_type(exec(type, !!!args), "scale_fill_binned", "fill")
-  } else {
-    type_fallback <- getOption("ggplot2.continuous.fill", default = "gradient")
-    # don't use fallback from scale_colour_continuous() if it is
-    # a function, since that would change the type of the color
-    # scale from binned to continuous
-    if (is.function(type_fallback)) {
-      type_fallback <- "gradient"
-    }
-    type <- type %||% type_fallback
+    scale <- exec(type, !!!args)
+    check_scale_type(scale, "scale_fill_binned", "fill")
+    return(scale)
+  }
 
-    if (identical(type, "gradient")) {
-      exec(scale_fill_steps, !!!args)
-    } else if (identical(type, "viridis")) {
-      exec(scale_fill_viridis_b, !!!args)
-    } else {
-      cli::cli_abort(c(
-        "Unknown scale type: {.val {type}}",
-        "i" = "Use either {.val gradient} or {.val viridis}."
-      ))
-    }
+  type_fallback <- getOption("ggplot2.continuous.fill", default = "gradient")
+  # don't use fallback from scale_colour_continuous() if it is
+  # a function, since that would change the type of the color
+  # scale from binned to continuous
+  if (is.function(type_fallback)) {
+    type_fallback <- "gradient"
+  }
+  type <- type %||% type_fallback
+
+  if (identical(type, "gradient")) {
+    exec(scale_fill_steps, !!!args)
+  } else if (identical(type, "viridis")) {
+    exec(scale_fill_viridis_b, !!!args)
+  } else {
+    cli::cli_abort(c(
+      "Unknown scale type: {.val {type}}",
+      "i" = "Use either {.val gradient} or {.val viridis}."
+    ))
   }
 }
 
@@ -219,6 +230,5 @@ check_scale_type <- function(scale, name, aesthetic, scale_is_discrete = FALSE,
       "x" = "The provided scale is {scale_types[2]}."
     ), call = call)
   }
-
-  scale
+  invisible()
 }
diff --git a/R/scale-hue.R b/R/scale-hue.R
index 414f10864e..b865c0acdd 100644
--- a/R/scale-hue.R
+++ b/R/scale-hue.R
@@ -140,19 +140,16 @@ scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour
   args <- list2(...)
   args$call <- args$call %||% current_call()
 
-  if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
-    }
-    check_scale_type(
-      exec(type, !!!args),
-      "scale_colour_discrete",
-      "colour",
-      scale_is_discrete = TRUE
-    )
-  } else {
-    exec(scale_colour_qualitative, !!!args, type = type)
+  if (!is.function(type)) {
+    scale <- exec(scale_colour_qualitative, !!!args, type = type)
+    return(scale)
+  }
+  if (!any(c("...", "call") %in% fn_fmls_names(type))) {
+    args$call <- NULL
   }
+  scale <- exec(type, !!!args)
+  check_scale_type(scale, "scale_colour_discrete", "colour", scale_is_discrete = TRUE)
+  return(scale)
 }
 
 #' @rdname scale_colour_discrete
@@ -163,19 +160,17 @@ scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill"))
   args <- list2(...)
   args$call <- args$call %||% current_call()
 
-  if (is.function(type)) {
-    if (!any(c("...", "call") %in% fn_fmls_names(type))) {
-      args$call <- NULL
-    }
-    check_scale_type(
-      exec(type, !!!args),
-      "scale_fill_discrete",
-      "fill",
-      scale_is_discrete = TRUE
-    )
-  } else {
-    exec(scale_fill_qualitative, !!!args, type = type)
+  if (!is.function(type)) {
+    scale <- exec(scale_fill_qualitative, !!!args, type = type)
+    return(scale)
+  }
+
+  if (!any(c("...", "call") %in% fn_fmls_names(type))) {
+    args$call <- NULL
   }
+  scale <- exec(type, !!!args)
+  check_scale_type(scale, "scale_fill_discrete", "fill", scale_is_discrete = TRUE)
+  scale
 }
 
 scale_colour_qualitative <- function(name = waiver(), ..., type = NULL,

From befd08361306de3be50b2156d5b3efc556a6ca49 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 13:56:03 +0200
Subject: [PATCH 09/16] `validate_theme/element()` is a check

---
 R/guide-.R                  | 2 +-
 R/theme-elements.R          | 2 +-
 R/theme.R                   | 8 ++++----
 tests/testthat/test-theme.R | 8 ++++----
 4 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/R/guide-.R b/R/guide-.R
index 17558b83f9..fb63ef501e 100644
--- a/R/guide-.R
+++ b/R/guide-.R
@@ -51,7 +51,7 @@ new_guide <- function(..., available_aes = "any", super) {
   # Validate theme settings
   if (!is.null(params$theme)) {
     check_object(params$theme, is.theme, what = "a {.cls theme} object")
-    validate_theme(params$theme, call = caller_env())
+    check_theme(params$theme, call = caller_env())
     params$direction <- params$direction %||% params$theme$legend.direction
   }
 
diff --git a/R/theme-elements.R b/R/theme-elements.R
index 747bb0cf78..e9e3b3b7ef 100644
--- a/R/theme-elements.R
+++ b/R/theme-elements.R
@@ -676,7 +676,7 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) {
 # @param el an element
 # @param elname the name of the element
 # @param element_tree the element tree to validate against
-validate_element <- function(el, elname, element_tree, call = caller_env()) {
+check_element <- function(el, elname, element_tree, call = caller_env()) {
   eldef <- element_tree[[elname]]
 
   if (is.null(eldef)) {
diff --git a/R/theme.R b/R/theme.R
index 43c379f9b6..107700abec 100644
--- a/R/theme.R
+++ b/R/theme.R
@@ -205,7 +205,7 @@
 #'   differently when added to a ggplot object. Also, when setting
 #'   `complete = TRUE` all elements will be set to inherit from blank
 #'   elements.
-#' @param validate `TRUE` to run `validate_element()`, `FALSE` to bypass checks.
+#' @param validate `TRUE` to run `check_element()`, `FALSE` to bypass checks.
 #' @export
 #' @seealso
 #'   [+.gg()] and [%+replace%],
@@ -552,12 +552,12 @@ is_theme_validate <- function(x) {
   isTRUE(validate %||% TRUE)
 }
 
-validate_theme <- function(theme, tree = get_element_tree(), call = caller_env()) {
+check_theme <- function(theme, tree = get_element_tree(), call = caller_env()) {
   if (!is_theme_validate(theme)) {
     return()
   }
   mapply(
-    validate_element, theme, names(theme),
+    check_element, theme, names(theme),
     MoreArgs = list(element_tree = tree, call = call)
   )
 }
@@ -618,7 +618,7 @@ plot_theme <- function(x, default = get_theme()) {
   theme[missing] <- ggplot_global$theme_default[missing]
 
   # Check that all elements have the correct class (element_text, unit, etc)
-  validate_theme(theme)
+  check_theme(theme)
 
   # Remove elements that are not registered
   theme[setdiff(names(theme), names(get_element_tree()))] <- NULL
diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R
index 9c10202504..d59b951526 100644
--- a/tests/testthat/test-theme.R
+++ b/tests/testthat/test-theme.R
@@ -250,7 +250,7 @@ test_that("complete and non-complete themes interact correctly with ggplot objec
   expect_equal(p$plot$theme$text$face, "italic")
 })
 
-test_that("theme(validate=FALSE) means do not validate_element", {
+test_that("theme(validate=FALSE) means do not check_element", {
   p <- ggplot(data.frame(x = 1:3), aes(x, x)) + geom_point()
   bw <- p + theme_bw()
   red.text <- theme(text = element_text(colour = "red"))
@@ -515,9 +515,9 @@ test_that("Theme elements are checked during build", {
 
 test_that("Theme validation behaves as expected", {
   tree <- get_element_tree()
-  expect_silent(validate_element(1,  "aspect.ratio", tree))
-  expect_silent(validate_element(1L, "aspect.ratio", tree))
-  expect_snapshot_error(validate_element("A", "aspect.ratio", tree))
+  expect_silent(check_element(1,  "aspect.ratio", tree))
+  expect_silent(check_element(1L, "aspect.ratio", tree))
+  expect_snapshot_error(check_element("A", "aspect.ratio", tree))
 })
 
 test_that("Element subclasses are inherited", {

From c2487de3f51537370303d0c9882433bf71890aeb Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 14:28:13 +0200
Subject: [PATCH 10/16] update labeller deprecation message

---
 R/labeller.R | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/R/labeller.R b/R/labeller.R
index f23f22b459..f3b61b24f2 100644
--- a/R/labeller.R
+++ b/R/labeller.R
@@ -595,15 +595,15 @@ check_labeller <- function(labeller) {
   is_deprecated <- all(c("variable", "value") %in% names(formals(labeller)))
 
   if (is_deprecated) {
+    deprecate_warn0(
+      "2.0.0", what = "facet_(labeller)",
+      details =
+      "Modern labellers do not take `variable` and `value` arguments anymore."
+    )
     old_labeller <- labeller
     labeller <- function(labels) {
       Map(old_labeller, names(labels), labels)
     }
-    # TODO Update to lifecycle after next lifecycle release
-    cli::cli_warn(c(
-      "The {.arg labeller} API has been updated. Labellers taking {.arg variable} and {.arg value} arguments are now deprecated.",
-      "i" = "See labellers documentation."
-    ))
   }
 
   labeller

From 8533322d1806e1124f2010685c7a13919f54d088 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 14:28:34 +0200
Subject: [PATCH 11/16] `check_labeller()` performs an update

---
 R/facet-grid-.R | 2 +-
 R/facet-wrap.R  | 2 +-
 R/labeller.R    | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/R/facet-grid-.R b/R/facet-grid-.R
index a0b6e31931..86ccc6be02 100644
--- a/R/facet-grid-.R
+++ b/R/facet-grid-.R
@@ -177,7 +177,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
   facets_list <- grid_as_facets_list(rows, cols)
 
   # Check for deprecated labellers
-  labeller <- check_labeller(labeller)
+  labeller <- update_labeller(labeller)
 
   ggproto(NULL, FacetGrid,
     shrink = shrink,
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 8564f319b7..687ba46c66 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -174,7 +174,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   )
 
   # Check for deprecated labellers
-  labeller <- check_labeller(labeller)
+  labeller <- update_labeller(labeller)
 
   # Flatten all facets dimensions into a single one
   facets <- wrap_as_facets_list(facets)
diff --git a/R/labeller.R b/R/labeller.R
index f3b61b24f2..8bdf5996c5 100644
--- a/R/labeller.R
+++ b/R/labeller.R
@@ -590,7 +590,7 @@ assemble_strips <- function(grobs, theme, horizontal = TRUE, clip) {
 }
 
 # Check for old school labeller
-check_labeller <- function(labeller) {
+update_labeller <- function(labeller) {
   labeller <- match.fun(labeller)
   is_deprecated <- all(c("variable", "value") %in% names(formals(labeller)))
 

From a2c6cf1c230e21935f5d77b14540bd82b961a8d6 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 14:32:12 +0200
Subject: [PATCH 12/16] `check_linewidth()` performs an update

---
 R/geom-.R            |  2 +-
 R/geom-boxplot.R     |  2 +-
 R/geom-crossbar.R    |  2 +-
 R/geom-errorbar.R    |  2 +-
 R/geom-errorbarh.R   |  2 +-
 R/geom-hex.R         |  2 +-
 R/geom-path.R        |  2 +-
 R/geom-polygon.R     |  2 +-
 R/geom-rect.R        |  2 +-
 R/geom-ribbon.R      |  2 +-
 R/geom-rug.R         |  2 +-
 R/geom-segment.R     |  2 +-
 R/utilities-checks.R | 43 +++++++++++++++++++++++++++++++++++++++++++
 13 files changed, 55 insertions(+), 12 deletions(-)

diff --git a/R/geom-.R b/R/geom-.R
index c864c234de..9dfed33d01 100644
--- a/R/geom-.R
+++ b/R/geom-.R
@@ -271,7 +271,7 @@ check_aesthetics <- function(x, n) {
   ))
 }
 
-check_linewidth <- function(data, name) {
+update_linewidth <- function(data, name) {
   if (is.null(data$linewidth) && !is.null(data$size)) {
     deprecate_soft0("3.4.0", I(paste0("Using the `size` aesthetic with ", name)), I("the `linewidth` aesthetic"))
     data$linewidth <- data$size
diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R
index 1ac23ba80f..656f08a517 100644
--- a/R/geom-boxplot.R
+++ b/R/geom-boxplot.R
@@ -227,7 +227,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
                         outlier.size = NULL, outlier.stroke = 0.5,
                         outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5,
                         staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     # this may occur when using geom_boxplot(stat = "identity")
     if (nrow(data) != 1) {
diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R
index 1f7c66f832..6d8dcc177a 100644
--- a/R/geom-crossbar.R
+++ b/R/geom-crossbar.R
@@ -55,7 +55,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "mitre", fatten = 2.5, width = NULL,
                         flipped_aes = FALSE) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
 
     middle <- transform(data, x = xmin, xend = xmax, yend = y, linewidth = linewidth * fatten, alpha = NA)
diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R
index 3e40b20318..c6a3059e85 100644
--- a/R/geom-errorbar.R
+++ b/R/geom-errorbar.R
@@ -60,7 +60,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         width = NULL, flipped_aes = FALSE) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     x <- vec_interleave(data$xmin, data$xmax, NA, data$x,    data$x,    NA, data$xmin, data$xmax)
     y <- vec_interleave(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)
diff --git a/R/geom-errorbarh.R b/R/geom-errorbarh.R
index c38b9b7cd6..d7e808bb24 100644
--- a/R/geom-errorbarh.R
+++ b/R/geom-errorbarh.R
@@ -74,7 +74,7 @@ GeomErrorbarh <- ggproto("GeomErrorbarh", Geom,
   },
 
   draw_panel = function(self, data, panel_params, coord, height = NULL, lineend = "butt") {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     GeomPath$draw_panel(data_frame0(
       x = vec_interleave(data$xmax, data$xmax, NA, data$xmax, data$xmin, NA, data$xmin, data$xmin),
       y = vec_interleave(data$ymin, data$ymax, NA, data$y,    data$y,    NA, data$ymin, data$ymax),
diff --git a/R/geom-hex.R b/R/geom-hex.R
index 6badb8f87a..9dc7917681 100644
--- a/R/geom-hex.R
+++ b/R/geom-hex.R
@@ -58,7 +58,7 @@ geom_hex <- function(mapping = NULL, data = NULL,
 GeomHex <- ggproto("GeomHex", Geom,
   draw_group = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "mitre", linemitre = 10) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     if (empty(data)) {
       return(zeroGrob())
     }
diff --git a/R/geom-path.R b/R/geom-path.R
index 72c4f7154e..68ff2b6989 100644
--- a/R/geom-path.R
+++ b/R/geom-path.R
@@ -165,7 +165,7 @@ GeomPath <- ggproto("GeomPath", Geom,
   draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
                         lineend = "butt", linejoin = "round", linemitre = 10,
                         na.rm = FALSE) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     if (!anyDuplicated(data$group)) {
       cli::cli_inform(c(
         "{.fn {snake_class(self)}}: Each group consists of only one observation.",
diff --git a/R/geom-polygon.R b/R/geom-polygon.R
index a271ef5011..01ae525e52 100644
--- a/R/geom-polygon.R
+++ b/R/geom-polygon.R
@@ -109,7 +109,7 @@ geom_polygon <- function(mapping = NULL, data = NULL,
 GeomPolygon <- ggproto("GeomPolygon", Geom,
   draw_panel = function(self, data, panel_params, coord, rule = "evenodd",
                         lineend = "butt", linejoin = "round", linemitre = 10) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     n <- nrow(data)
     if (n == 1) return(zeroGrob())
 
diff --git a/R/geom-rect.R b/R/geom-rect.R
index 8473474525..949dbd1553 100644
--- a/R/geom-rect.R
+++ b/R/geom-rect.R
@@ -69,7 +69,7 @@ GeomRect <- ggproto("GeomRect", Geom,
   },
 
   draw_panel = function(self, data, panel_params, coord, lineend = "butt", linejoin = "mitre") {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     if (!coord$is_linear()) {
       aesthetics <- setdiff(
         names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax")
diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R
index 470c013eee..a802c6c55f 100644
--- a/R/geom-ribbon.R
+++ b/R/geom-ribbon.R
@@ -133,7 +133,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
   draw_group = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "round", linemitre = 10, na.rm = FALSE,
                         flipped_aes = FALSE, outline.type = "both") {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ]
     data <- data[order(data$group), ]
diff --git a/R/geom-rug.R b/R/geom-rug.R
index d675474f43..00d4815d2f 100644
--- a/R/geom-rug.R
+++ b/R/geom-rug.R
@@ -90,7 +90,7 @@ GeomRug <- ggproto("GeomRug", Geom,
 
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         sides = "bl", outside = FALSE, length = unit(0.03, "npc")) {
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     check_inherits(length, "unit")
     rugs <- list()
     data <- coord$transform(data, panel_params)
diff --git a/R/geom-segment.R b/R/geom-segment.R
index 00d9eff87a..20f6433704 100644
--- a/R/geom-segment.R
+++ b/R/geom-segment.R
@@ -116,7 +116,7 @@ GeomSegment <- ggproto("GeomSegment", Geom,
                         lineend = "butt", linejoin = "round", na.rm = FALSE) {
     data$xend <- data$xend %||% data$x
     data$yend <- data$yend %||% data$y
-    data <- check_linewidth(data, snake_class(self))
+    data <- update_linewidth(data, snake_class(self))
     data <- remove_missing(data, na.rm = na.rm,
       c("x", "y", "xend", "yend", "linetype", "linewidth"),
       name = "geom_segment"
diff --git a/R/utilities-checks.R b/R/utilities-checks.R
index a1ed1b5091..fb04447bed 100644
--- a/R/utilities-checks.R
+++ b/R/utilities-checks.R
@@ -69,6 +69,49 @@ check_inherits <- function(x,
   )
 }
 
+check_length <- function(x, length = integer(), ..., min = 0, max = Inf,
+                         arg = caller_arg(x), call = caller_env()) {
+  n <- length(x)
+  if (n %in% length) {
+    return(invisible(NULL))
+  }
+  if (length(length) > 0) {
+    type <- if (length(length) == 1) {
+      switch(as.character(length), "0" = "empty vector", "1" = "scalar", "vector")
+    } else {
+      "vector"
+    }
+    cli::cli_abort(
+      "{.arg {arg}} must be a {type} of length {.or {length}}, not length {n}.",
+      call = call, arg = arg
+    )
+  }
+
+  range <- pmax(range(min, max), 0)
+  if (n >= min & n <= max) {
+    return(invisible(NULL))
+  }
+  if (identical(range[1], range[2])) {
+    check_length(x, range[1], arg = arg, call = call)
+    return(invisible(NULL))
+  }
+
+  type <- if (range[2] == 1) "scalar" else "vector"
+  msg  <- "{.arg {arg}} must be a {type} with "
+
+  if (identical(range[2], Inf)) {
+    msg <- c(msg, "at least length {range[1]}")
+  }
+  if (identical(range[1], 0)) {
+    msg <- c(msg, "at most length {range[2]}")
+  }
+  if (length(msg) == 1) {
+    msg <- c(msg, "a length between {.and {range}}")
+  }
+  msg <- paste0(c(msg, ", not length {n}."), collapse = "")
+  cli::cli_abort(msg, call = call, arg = arg)
+}
+
 #' Check graphics device capabilities
 #'
 #' This function makes an attempt to estimate whether the graphics device is

From 981509e7bfa27afd9656b5ba7b641e10ad1cfc61 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Tue, 3 Sep 2024 14:34:55 +0200
Subject: [PATCH 13/16] `check_polar_guide()` is validator

---
 R/coord-radial.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/R/coord-radial.R b/R/coord-radial.R
index 3a5ccf1ee2..8716e44c8a 100644
--- a/R/coord-radial.R
+++ b/R/coord-radial.R
@@ -180,7 +180,7 @@ CoordRadial <- ggproto("CoordRadial", Coord,
     # Validate appropriateness of guides
     drop_guides <- character(0)
     for (type in aesthetics) {
-      drop_guides <- check_polar_guide(drop_guides, guides, type)
+      drop_guides <- validate_polar_guide(drop_guides, guides, type)
     }
 
     guide_params <- guides$get_params(aesthetics)
@@ -648,7 +648,7 @@ theta_grid <- function(theta, element, inner_radius = c(0, 0.4),
   )
 }
 
-check_polar_guide <- function(drop_list, guides, type = "theta") {
+validate_polar_guide <- function(drop_list, guides, type = "theta") {
   guide <- guides$get_guide(type)
   primary <- gsub("\\.sec$", "", type)
   if (inherits(guide, "GuideNone") || primary %in% guide$available_aes) {

From 7949e20ecd4849af496f87a052cc4b25b6c10929 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 16 Dec 2024 11:37:58 +0100
Subject: [PATCH 14/16] `update_labeller()` -> `fix_labeller()`

---
 R/facet-grid-.R | 2 +-
 R/facet-wrap.R  | 2 +-
 R/labeller.R    | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/facet-grid-.R b/R/facet-grid-.R
index 518b483604..be11524541 100644
--- a/R/facet-grid-.R
+++ b/R/facet-grid-.R
@@ -177,7 +177,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
   facets_list <- grid_as_facets_list(rows, cols)
 
   # Check for deprecated labellers
-  labeller <- update_labeller(labeller)
+  labeller <- fix_labeller(labeller)
 
   ggproto(NULL, FacetGrid,
     shrink = shrink,
diff --git a/R/facet-wrap.R b/R/facet-wrap.R
index 7d8a56c2ec..6bc72f8af4 100644
--- a/R/facet-wrap.R
+++ b/R/facet-wrap.R
@@ -174,7 +174,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   )
 
   # Check for deprecated labellers
-  labeller <- update_labeller(labeller)
+  labeller <- fix_labeller(labeller)
 
   # Flatten all facets dimensions into a single one
   facets <- compact_facets(facets)
diff --git a/R/labeller.R b/R/labeller.R
index 50d7a23b6d..a9ba883a79 100644
--- a/R/labeller.R
+++ b/R/labeller.R
@@ -577,8 +577,8 @@ assemble_strips <- function(grobs, theme, horizontal = TRUE, clip) {
   })
 }
 
-# Check for old school labeller
-update_labeller <- function(labeller) {
+# Repair old school labeller
+fix_labeller <- function(labeller) {
   labeller <- match.fun(labeller)
   is_deprecated <- all(c("variable", "value") %in% names(formals(labeller)))
 

From 806ded883e42c322baf77ee84e56dc5356237783 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 16 Dec 2024 11:39:13 +0100
Subject: [PATCH 15/16] `update_linewidth()` -> `fix_linewidth()`

---
 R/geom-.R         | 2 +-
 R/geom-boxplot.R  | 2 +-
 R/geom-crossbar.R | 2 +-
 R/geom-errorbar.R | 2 +-
 R/geom-hex.R      | 2 +-
 R/geom-path.R     | 2 +-
 R/geom-polygon.R  | 2 +-
 R/geom-rect.R     | 2 +-
 R/geom-ribbon.R   | 2 +-
 R/geom-rug.R      | 2 +-
 R/geom-segment.R  | 2 +-
 11 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/R/geom-.R b/R/geom-.R
index 1f1208a22d..f8b5027438 100644
--- a/R/geom-.R
+++ b/R/geom-.R
@@ -277,7 +277,7 @@ check_aesthetics <- function(x, n) {
   ))
 }
 
-update_linewidth <- function(data, name) {
+fix_linewidth <- function(data, name) {
   if (is.null(data$linewidth) && !is.null(data$size)) {
     deprecate_soft0("3.4.0", I(paste0("Using the `size` aesthetic with ", name)), I("the `linewidth` aesthetic"))
     data$linewidth <- data$size
diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R
index d1eab0057c..76b09900e1 100644
--- a/R/geom-boxplot.R
+++ b/R/geom-boxplot.R
@@ -286,7 +286,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
                         whisker_gp = NULL, staple_gp = NULL, median_gp = NULL,
                         box_gp = NULL, notch = FALSE, notchwidth = 0.5,
                         staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     # this may occur when using geom_boxplot(stat = "identity")
     if (nrow(data) != 1) {
diff --git a/R/geom-crossbar.R b/R/geom-crossbar.R
index 79ae376fc6..7316033de6 100644
--- a/R/geom-crossbar.R
+++ b/R/geom-crossbar.R
@@ -84,7 +84,7 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "mitre", fatten = 2.5, width = NULL,
                         flipped_aes = FALSE, middle_gp = NULL, box_gp = NULL) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
 
     middle <- transform(data, x = xmin, xend = xmax, yend = y, linewidth = linewidth * fatten, alpha = NA)
diff --git a/R/geom-errorbar.R b/R/geom-errorbar.R
index 36673790b7..cd87edc652 100644
--- a/R/geom-errorbar.R
+++ b/R/geom-errorbar.R
@@ -89,7 +89,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         width = NULL, flipped_aes = FALSE) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     x <- vec_interleave(data$xmin, data$xmax, NA, data$x,    data$x,    NA, data$xmin, data$xmax)
     y <- vec_interleave(data$ymax, data$ymax, NA, data$ymax, data$ymin, NA, data$ymin, data$ymin)
diff --git a/R/geom-hex.R b/R/geom-hex.R
index 779bd29149..5add9250c8 100644
--- a/R/geom-hex.R
+++ b/R/geom-hex.R
@@ -58,7 +58,7 @@ geom_hex <- function(mapping = NULL, data = NULL,
 GeomHex <- ggproto("GeomHex", Geom,
   draw_group = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "mitre", linemitre = 10) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     if (empty(data)) {
       return(zeroGrob())
     }
diff --git a/R/geom-path.R b/R/geom-path.R
index 68ff2b6989..fe930363a6 100644
--- a/R/geom-path.R
+++ b/R/geom-path.R
@@ -165,7 +165,7 @@ GeomPath <- ggproto("GeomPath", Geom,
   draw_panel = function(self, data, panel_params, coord, arrow = NULL, arrow.fill = NULL,
                         lineend = "butt", linejoin = "round", linemitre = 10,
                         na.rm = FALSE) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     if (!anyDuplicated(data$group)) {
       cli::cli_inform(c(
         "{.fn {snake_class(self)}}: Each group consists of only one observation.",
diff --git a/R/geom-polygon.R b/R/geom-polygon.R
index 01ae525e52..a97d3c2194 100644
--- a/R/geom-polygon.R
+++ b/R/geom-polygon.R
@@ -109,7 +109,7 @@ geom_polygon <- function(mapping = NULL, data = NULL,
 GeomPolygon <- ggproto("GeomPolygon", Geom,
   draw_panel = function(self, data, panel_params, coord, rule = "evenodd",
                         lineend = "butt", linejoin = "round", linemitre = 10) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     n <- nrow(data)
     if (n == 1) return(zeroGrob())
 
diff --git a/R/geom-rect.R b/R/geom-rect.R
index 949dbd1553..1765a2506a 100644
--- a/R/geom-rect.R
+++ b/R/geom-rect.R
@@ -69,7 +69,7 @@ GeomRect <- ggproto("GeomRect", Geom,
   },
 
   draw_panel = function(self, data, panel_params, coord, lineend = "butt", linejoin = "mitre") {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     if (!coord$is_linear()) {
       aesthetics <- setdiff(
         names(data), c("x", "y", "xmin", "xmax", "ymin", "ymax")
diff --git a/R/geom-ribbon.R b/R/geom-ribbon.R
index 4faab7e375..ee5a43b20e 100644
--- a/R/geom-ribbon.R
+++ b/R/geom-ribbon.R
@@ -133,7 +133,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom,
   draw_group = function(self, data, panel_params, coord, lineend = "butt",
                         linejoin = "round", linemitre = 10, na.rm = FALSE,
                         flipped_aes = FALSE, outline.type = "both") {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     if (na.rm) data <- data[stats::complete.cases(data[c("x", "ymin", "ymax")]), ]
     data <- data[order(data$group), ]
diff --git a/R/geom-rug.R b/R/geom-rug.R
index 0b03806e64..8992f1069d 100644
--- a/R/geom-rug.R
+++ b/R/geom-rug.R
@@ -90,7 +90,7 @@ GeomRug <- ggproto("GeomRug", Geom,
 
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         sides = "bl", outside = FALSE, length = unit(0.03, "npc")) {
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     check_inherits(length, "unit")
     rugs <- list()
     data <- coord$transform(data, panel_params)
diff --git a/R/geom-segment.R b/R/geom-segment.R
index 20f6433704..51de135b53 100644
--- a/R/geom-segment.R
+++ b/R/geom-segment.R
@@ -116,7 +116,7 @@ GeomSegment <- ggproto("GeomSegment", Geom,
                         lineend = "butt", linejoin = "round", na.rm = FALSE) {
     data$xend <- data$xend %||% data$x
     data$yend <- data$yend %||% data$y
-    data <- update_linewidth(data, snake_class(self))
+    data <- fix_linewidth(data, snake_class(self))
     data <- remove_missing(data, na.rm = na.rm,
       c("x", "y", "xend", "yend", "linetype", "linewidth"),
       name = "geom_segment"

From cb85b031c535f01d9413c2eac898a2d480e297c2 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <tahvdbrand@gmail.com>
Date: Mon, 16 Dec 2024 11:50:42 +0100
Subject: [PATCH 16/16] `check_facet_class()` --> `check_vars()`

---
 R/facet-.R                      | 4 ++--
 tests/testthat/_snaps/facet-.md | 6 +++---
 tests/testthat/test-facet-.R    | 6 +++---
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/R/facet-.R b/R/facet-.R
index c6ed7951a1..0c120beba3 100644
--- a/R/facet-.R
+++ b/R/facet-.R
@@ -443,7 +443,7 @@ df.grid <- function(a, b) {
 # facetting variables.
 
 as_facets_list <- function(x) {
-  check_facet_class(x)
+  check_vars(x)
   if (is_quosures(x)) {
     x <- quos_auto_name(x)
     return(list(x))
@@ -487,7 +487,7 @@ as_facets_list <- function(x) {
   x
 }
 
-check_facet_class <- function(x) {
+check_vars <- function(x) {
   if (is.mapping(x)) {
     cli::cli_abort("Please use {.fn vars} to supply facet variables.")
   }
diff --git a/tests/testthat/_snaps/facet-.md b/tests/testthat/_snaps/facet-.md
index b2b56b211a..154499e38a 100644
--- a/tests/testthat/_snaps/facet-.md
+++ b/tests/testthat/_snaps/facet-.md
@@ -3,7 +3,7 @@
     Code
       facet_wrap(aes(foo))
     Condition
-      Error in `check_facet_class()`:
+      Error in `check_vars()`:
       ! Please use `vars()` to supply facet variables.
 
 ---
@@ -11,7 +11,7 @@
     Code
       facet_grid(aes(foo))
     Condition
-      Error in `check_facet_class()`:
+      Error in `check_vars()`:
       ! Please use `vars()` to supply facet variables.
 
 # facet_grid() fails if passed both a formula and a vars()
@@ -73,7 +73,7 @@
       Error:
       ! object 'no_such_variable' not found
 
-# check_facet_class() provide meaningful errors
+# check_vars() provide meaningful errors
 
     Please use `vars()` to supply facet variables.
 
diff --git a/tests/testthat/test-facet-.R b/tests/testthat/test-facet-.R
index 9f48232532..a24a5e4ca5 100644
--- a/tests/testthat/test-facet-.R
+++ b/tests/testthat/test-facet-.R
@@ -469,9 +469,9 @@ test_that("eval_facet() is tolerant for missing columns (#2963)", {
   )
 })
 
-test_that("check_facet_class() provide meaningful errors", {
-  expect_snapshot_error(check_facet_class(aes(var)))
-  expect_snapshot_error(check_facet_class(ggplot()))
+test_that("check_vars() provide meaningful errors", {
+  expect_snapshot_error(check_vars(aes(var)))
+  expect_snapshot_error(check_vars(ggplot()))
 })
 
 test_that("check_layout() throws meaningful errors", {