From 80af22994aa2cea9ec496e9936b34fa481c1bc37 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:27:36 +0200 Subject: [PATCH 01/12] re-import standalone rlang files --- R/import-standalone-obj-type.R | 29 ++++++++++++++++++++++------- R/import-standalone-types-check.R | 20 ++++++++++++++++++-- tests/testthat/_snaps/qplot.md | 2 +- tests/testthat/test-scale-date.R | 2 +- 4 files changed, 42 insertions(+), 11 deletions(-) diff --git a/R/import-standalone-obj-type.R b/R/import-standalone-obj-type.R index 72cfe37dc2..47268d620d 100644 --- a/R/import-standalone-obj-type.R +++ b/R/import-standalone-obj-type.R @@ -1,17 +1,27 @@ # Standalone file: do not edit by hand -# Source: +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-obj-type.R +# Generated by: usethis::use_standalone("r-lib/rlang", "obj-type") # ---------------------------------------------------------------------- # # --- # repo: r-lib/rlang # file: standalone-obj-type.R -# last-updated: 2022-10-04 +# last-updated: 2024-02-14 # license: https://unlicense.org # imports: rlang (>= 1.1.0) # --- # # ## Changelog # +# 2024-02-14: +# - `obj_type_friendly()` now works for S7 objects. +# +# 2023-05-01: +# - `obj_type_friendly()` now only displays the first class of S3 objects. +# +# 2023-03-30: +# - `stop_input_type()` now handles `I()` input literally in `arg`. +# # 2022-10-04: # - `obj_type_friendly(value = TRUE)` now shows numeric scalars # literally. @@ -65,7 +75,7 @@ obj_type_friendly <- function(x, value = TRUE) { if (inherits(x, "quosure")) { type <- "quosure" } else { - type <- paste(class(x), collapse = "/") + type <- class(x)[[1L]] } return(sprintf("a <%s> object", type)) } @@ -261,19 +271,19 @@ vec_type_friendly <- function(x, length = FALSE) { #' Return OO type #' @param x Any R object. #' @return One of `"bare"` (for non-OO objects), `"S3"`, `"S4"`, -#' `"R6"`, or `"R7"`. +#' `"R6"`, or `"S7"`. #' @noRd obj_type_oo <- function(x) { if (!is.object(x)) { return("bare") } - class <- inherits(x, c("R6", "R7_object"), which = TRUE) + class <- inherits(x, c("R6", "S7_object"), which = TRUE) if (class[[1]]) { "R6" } else if (class[[2]]) { - "R7" + "S7" } else if (isS4(x)) { "S4" } else { @@ -315,10 +325,15 @@ stop_input_type <- function(x, if (length(what)) { what <- oxford_comma(what) } + if (inherits(arg, "AsIs")) { + format_arg <- identity + } else { + format_arg <- cli$format_arg + } message <- sprintf( "%s must be %s, not %s.", - cli$format_arg(arg), + format_arg(arg), what, obj_type_friendly(x, value = show_value) ) diff --git a/R/import-standalone-types-check.R b/R/import-standalone-types-check.R index 6782d69b10..ef8c5a1d5e 100644 --- a/R/import-standalone-types-check.R +++ b/R/import-standalone-types-check.R @@ -1,5 +1,6 @@ # Standalone file: do not edit by hand -# Source: +# Source: https://github.com/r-lib/rlang/blob/HEAD/R/standalone-types-check.R +# Generated by: usethis::use_standalone("r-lib/rlang", "types-check") # ---------------------------------------------------------------------- # # --- @@ -13,6 +14,9 @@ # # ## Changelog # +# 2024-08-15: +# - `check_character()` gains an `allow_na` argument (@martaalcalde, #1724) +# # 2023-03-13: # - Improved error messages of number checkers (@teunbrand) # - Added `allow_infinite` argument to `check_number_whole()` (@mgirlich). @@ -461,15 +465,28 @@ check_formula <- function(x, # Vectors ----------------------------------------------------------------- +# TODO: Figure out what to do with logical `NA` and `allow_na = TRUE` + check_character <- function(x, ..., + allow_na = TRUE, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { + if (!missing(x)) { if (is_character(x)) { + if (!allow_na && any(is.na(x))) { + abort( + sprintf("`%s` can't contain NA values.", arg), + arg = arg, + call = call + ) + } + return(invisible(NULL)) } + if (allow_null && is_null(x)) { return(invisible(NULL)) } @@ -479,7 +496,6 @@ check_character <- function(x, x, "a character vector", ..., - allow_na = FALSE, allow_null = allow_null, arg = arg, call = call diff --git a/tests/testthat/_snaps/qplot.md b/tests/testthat/_snaps/qplot.md index 6513d2deb0..c95b8b3d2d 100644 --- a/tests/testthat/_snaps/qplot.md +++ b/tests/testthat/_snaps/qplot.md @@ -1,4 +1,4 @@ # qplot() only work with character geom - `geom` must be a character vector, not a object. + `geom` must be a character vector, not a object. diff --git a/tests/testthat/test-scale-date.R b/tests/testthat/test-scale-date.R index 1183fcd756..2e0ec34316 100644 --- a/tests/testthat/test-scale-date.R +++ b/tests/testthat/test-scale-date.R @@ -79,7 +79,7 @@ test_that("date(time) scales throw warnings when input is numeric", { expect_warning( ggplot_build(p + scale_x_datetime()), - "The value was converted to a object." + "The value was converted to a object." ) }) From 4753e61ede864f946b52ea1520474af71b88ebc4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:34:45 +0200 Subject: [PATCH 02/12] add length checker --- R/utilities-checks.R | 54 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index a1ed1b5091..5cedbe7cb8 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -69,6 +69,60 @@ check_inherits <- function(x, ) } +check_length <- function(x, length = integer(), ..., min = 0, max = Inf, + arg = caller_arg(x), call = caller_env()) { + if (missing(x)) { + stop_input_type(x, "a vector", arg = arg, call = call) + } + + n <- length(x) + if (n %in% length) { + return(invisible(NULL)) + } + fmt <- if (inherits(arg, "AsIs")) identity else function(x) sprintf("`%s`", x) + if (length(length) > 0) { + type <- paste0("a vector of length ", oxford_comma(length)) + if (length(length) == 1) { + type <- switch( + sprintf("%d", length), + "0" = "an empty vector", + "1" = "a scalar of length 1", + type + ) + } + msg <- sprintf( + "%s must be %s, not length %d.", + fmt(arg), type, n + ) + cli::cli_abort(msg, call = call, arg = arg) + } + + range <- pmax(range(min, max, na.rm = TRUE), 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" + + what <- paste0("a length between ", range[1], " and ", range[2]) + if (identical(range[2], Inf)) { + what <- paste0("at least length ", range[1]) + } + if (identical(range[1], 0)) { + what <- paste0("at most length ", range[2]) + } + + msg <- sprintf( + "`%s` must be a %s with %s, not length %d.", + fmt(arg), type, what, n + ) + 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 02358b4695bdc36396df9b70c192e27348662d7f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:35:34 +0200 Subject: [PATCH 03/12] add `allow_na` option to `check_object()` --- R/utilities-checks.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/utilities-checks.R b/R/utilities-checks.R index 5cedbe7cb8..d444e8c3d0 100644 --- a/R/utilities-checks.R +++ b/R/utilities-checks.R @@ -7,6 +7,7 @@ check_object <- function(x, check_fun, what, ..., + allow_na = FALSE, allow_null = FALSE, arg = caller_arg(x), call = caller_env()) { @@ -18,6 +19,9 @@ check_object <- function(x, if (allow_null && is_null(x)) { return(invisible(NULL)) } + if (allow_na && all(is.na(x))) { + return(invisible(NULL)) + } } stop_input_type( From 6b480d52a7a4f7808f35284dcc43a018fc09cc48 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:36:00 +0200 Subject: [PATCH 04/12] simplify coord limit check --- R/coord-.R | 12 ++---------- tests/testthat/_snaps/coord-cartesian.md | 4 ++-- tests/testthat/_snaps/coord-flip.md | 4 ++-- tests/testthat/_snaps/coord-map.md | 4 ++-- tests/testthat/_snaps/coord-transform.md | 4 ++-- tests/testthat/_snaps/coord_sf.md | 4 ++-- 6 files changed, 12 insertions(+), 20 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index 0d0bb5ecb9..ab7be0aafb 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -271,14 +271,6 @@ check_coord_limits <- function( if (is.null(limits)) { return(invisible(NULL)) } - if (!obj_is_vector(limits) || length(limits) != 2) { - what <- "{.obj_type_friendly {limits}}" - if (is.vector(limits)) { - what <- paste0(what, " of length {length(limits)}") - } - cli::cli_abort( - paste0("{.arg {arg}} must be a vector of length 2, not ", what, "."), - call = call - ) - } + check_numeric(limits, arg = arg, call = call) + check_length(limits, 2L, arg = arg, call = call) } diff --git a/tests/testthat/_snaps/coord-cartesian.md b/tests/testthat/_snaps/coord-cartesian.md index e7ed10569a..7273730f8c 100644 --- a/tests/testthat/_snaps/coord-cartesian.md +++ b/tests/testthat/_snaps/coord-cartesian.md @@ -1,8 +1,8 @@ # cartesian coords throws error when limits are badly specified - `xlim` must be a vector of length 2, not a object. + `xlim` must be a vector, not a object. --- - `ylim` must be a vector of length 2, not an integer vector of length 3. + `ylim` must be a vector of length 2, not length 3. diff --git a/tests/testthat/_snaps/coord-flip.md b/tests/testthat/_snaps/coord-flip.md index 99806717ba..360c49a03f 100644 --- a/tests/testthat/_snaps/coord-flip.md +++ b/tests/testthat/_snaps/coord-flip.md @@ -1,8 +1,8 @@ # flip coords throws error when limits are badly specified - `xlim` must be a vector of length 2, not a object. + `xlim` must be a vector, not a object. --- - `ylim` must be a vector of length 2, not an integer vector of length 3. + `ylim` must be a vector of length 2, not length 3. diff --git a/tests/testthat/_snaps/coord-map.md b/tests/testthat/_snaps/coord-map.md index 011a6dd41f..9e9e4f6c82 100644 --- a/tests/testthat/_snaps/coord-map.md +++ b/tests/testthat/_snaps/coord-map.md @@ -1,10 +1,10 @@ # coord map throws error when limits are badly specified - `xlim` must be a vector of length 2, not a object. + `xlim` must be a vector, not a object. --- - `ylim` must be a vector of length 2, not an integer vector of length 3. + `ylim` must be a vector of length 2, not length 3. # coord_map throws informative warning about guides diff --git a/tests/testthat/_snaps/coord-transform.md b/tests/testthat/_snaps/coord-transform.md index def35a0f27..cb78f0fcf6 100644 --- a/tests/testthat/_snaps/coord-transform.md +++ b/tests/testthat/_snaps/coord-transform.md @@ -1,8 +1,8 @@ # coord_trans() throws error when limits are badly specified - `xlim` must be a vector of length 2, not a object. + `xlim` must be a vector, not a object. --- - `ylim` must be a vector of length 2, not an integer vector of length 3. + `ylim` must be a vector of length 2, not length 3. diff --git a/tests/testthat/_snaps/coord_sf.md b/tests/testthat/_snaps/coord_sf.md index bb43424d33..358c9c05d3 100644 --- a/tests/testthat/_snaps/coord_sf.md +++ b/tests/testthat/_snaps/coord_sf.md @@ -21,9 +21,9 @@ # coord_sf() throws error when limits are badly specified - `xlim` must be a vector of length 2, not a object. + `xlim` must be a vector, not a object. --- - `ylim` must be a vector of length 2, not an integer vector of length 3. + `ylim` must be a vector of length 2, not length 3. From 6bee55911593c526724229928764b55c594dfbfe Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:36:40 +0200 Subject: [PATCH 05/12] use `check_length()` more often --- R/bin.R | 8 ++------ R/limits.R | 16 ++++------------ R/plot-build.R | 11 ++++------- R/stat-qq-line.R | 4 +--- tests/testthat/_snaps/limits.md | 2 +- tests/testthat/_snaps/stat-bin.md | 4 ++-- tests/testthat/_snaps/stat-qq.md | 2 +- 7 files changed, 15 insertions(+), 32 deletions(-) diff --git a/R/bin.R b/R/bin.R index a7784d02e5..055721f0e4 100644 --- a/R/bin.R +++ b/R/bin.R @@ -54,9 +54,7 @@ bin_breaks <- function(breaks, closed = c("right", "left")) { bin_breaks_width <- function(x_range, width = NULL, center = NULL, boundary = NULL, closed = c("right", "left")) { - if (length(x_range) != 2) { - cli::cli_abort("{.arg x_range} must have two elements.") - } + check_length(x_range, 2L) # binwidth seems to be the argument name supplied to width. (stat-bin and stat-bindot) check_number_decimal(width, min = 0, allow_infinite = FALSE, arg = "binwidth") @@ -106,9 +104,7 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL, bin_breaks_bins <- function(x_range, bins = 30, center = NULL, boundary = NULL, closed = c("right", "left")) { - if (length(x_range) != 2) { - cli::cli_abort("{.arg x_range} must have two elements.") - } + check_length(x_range, 2L) check_number_whole(bins, min = 1) if (zero_range(x_range)) { diff --git a/R/limits.R b/R/limits.R index 087c4c11d0..29c5d18a87 100644 --- a/R/limits.R +++ b/R/limits.R @@ -113,9 +113,7 @@ ylim <- function(...) { limits <- function(lims, var, call = caller_env()) UseMethod("limits") #' @export limits.numeric <- function(lims, var, call = caller_env()) { - if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) - } + check_length(lims, 2L, arg = var, call = call) if (!anyNA(lims) && lims[1] > lims[2]) { trans <- "reverse" } else { @@ -143,23 +141,17 @@ limits.factor <- function(lims, var, call = caller_env()) { } #' @export limits.Date <- function(lims, var, call = caller_env()) { - if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) - } + check_length(lims, 2L, arg = var, call = call) make_scale("date", var, limits = lims, call = call) } #' @export limits.POSIXct <- function(lims, var, call = caller_env()) { - if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) - } + check_length(lims, 2L, arg = var, call = call) make_scale("datetime", var, limits = lims, call = call) } #' @export limits.POSIXlt <- function(lims, var, call = caller_env()) { - if (length(lims) != 2) { - cli::cli_abort("{.arg {var}} must be a two-element vector.", call = call) - } + check_length(lims, 2L, arg = var, call = call) make_scale("datetime", var, limits = as.POSIXct(lims), call = call) } diff --git a/R/plot-build.R b/R/plot-build.R index 36f33616fd..88493ac4ae 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -358,13 +358,10 @@ table_add_tag <- function(table, label, theme) { ), call = expr(theme())) } - if (length(position) != 2) { - cli::cli_abort(paste0( - "A {.cls numeric} {.arg plot.tag.position} ", - "theme setting must have length 2." - ), - call = expr(theme())) - } + check_length( + position, 2L, call = expr(theme()), + arg = I("A {.cls numeric} {.arg plot.tag.position}") + ) top <- left <- right <- bottom <- FALSE } else { # Break position into top/left/right/bottom diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index 8133216779..a78ee6ecb9 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -71,9 +71,7 @@ StatQqLine <- ggproto("StatQqLine", Stat, theoretical <- inject(distribution(p = quantiles, !!!dparams)) - if (length(line.p) != 2) { - cli::cli_abort("Cannot fit line quantiles {line.p}. {.arg line.p} must have length 2.") - } + check_length(line.p, 2L) x_coords <- inject(distribution(p = line.p, !!!dparams)) y_coords <- stats::quantile(sample, line.p) diff --git a/tests/testthat/_snaps/limits.md b/tests/testthat/_snaps/limits.md index b7f4ffd960..f52f2e94e5 100644 --- a/tests/testthat/_snaps/limits.md +++ b/tests/testthat/_snaps/limits.md @@ -4,5 +4,5 @@ --- - `linewidth` must be a two-element vector. + `linewidth` must be a vector of length 2, not length 1. diff --git a/tests/testthat/_snaps/stat-bin.md b/tests/testthat/_snaps/stat-bin.md index dd7a8127bf..b72664af30 100644 --- a/tests/testthat/_snaps/stat-bin.md +++ b/tests/testthat/_snaps/stat-bin.md @@ -29,7 +29,7 @@ --- - `x_range` must have two elements. + `x_range` must be a vector of length 2, not length 1. --- @@ -45,7 +45,7 @@ --- - `x_range` must have two elements. + `x_range` must be a vector of length 2, not length 1. --- diff --git a/tests/testthat/_snaps/stat-qq.md b/tests/testthat/_snaps/stat-qq.md index 3be2b1b4e4..9c943fdd29 100644 --- a/tests/testthat/_snaps/stat-qq.md +++ b/tests/testthat/_snaps/stat-qq.md @@ -14,5 +14,5 @@ Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: - ! Cannot fit line quantiles 0.15. `line.p` must have length 2. + ! `line.p` must be a a vector of length 2, not length 1. From d37e8dc4811e7d234b2b6bbcaaf6a2254deb4e4f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:37:05 +0200 Subject: [PATCH 06/12] add `check_continuous_limits()` --- R/scale-.R | 14 +++++++++++++- tests/testthat/test-scales-breaks-labels.R | 2 +- 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index fd0bbd444f..4117883fc9 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -128,12 +128,14 @@ continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, nam } transform <- as.transform(transform) + limits <- allow_lambda(limits) + if (!is.null(limits) && !is.function(limits)) { limits <- transform$transform(limits) } + check_continuous_limits(limits, call = call) # Convert formula to function if appropriate - limits <- allow_lambda(limits) breaks <- allow_lambda(breaks) labels <- allow_lambda(labels) rescaler <- allow_lambda(rescaler) @@ -1402,6 +1404,16 @@ check_transformation <- function(x, transformed, name, arg = NULL, call = NULL) cli::cli_warn(msg, call = call) } +check_continuous_limits <- function(limits, ..., + arg = caller_arg(limits), + call = caller_env()) { + if (is.null(limits) || is.function(limits)) { + return(invisible()) + } + check_numeric(limits, arg = arg, call = call, allow_na = TRUE) + check_length(limits, 2L, arg = arg, call = call) +} + trans_support_nbreaks <- function(trans) { "n" %in% names(formals(trans$breaks)) } diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index c3a314cacc..882f6e19b8 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -79,7 +79,7 @@ test_that("out-of-range breaks are dropped", { test_that("no minor breaks when only one break", { sc1 <- scale_x_discrete(limits = "a") - sc2 <- scale_x_continuous(limits = 1) + sc2 <- scale_x_continuous(limits = c(1, 1)) expect_length(sc1$get_breaks_minor(), 0) expect_length(sc2$get_breaks_minor(), 0) From 6c60bac10cc3b965a8fd82d06c7b4bd8d7690e1c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 17 Sep 2024 17:39:14 +0200 Subject: [PATCH 07/12] add test --- tests/testthat/test-scales.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 0ba2989e39..f8881a16a7 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -731,6 +731,17 @@ test_that("Discrete scales with only NAs return `na.value`", { expect_equal(sc$map(x), c(NA_real_, NA_real_)) }) +test_that("continuous scales warn about faulty `limits`", { + expect_error( + scale_x_continuous(limits = c("A", "B")), + "not a character vector" + ) + expect_error( + scale_x_continuous(limits = 1:3), + "length 2, not length 3" + ) +}) + test_that("discrete scales work with NAs in arbitrary positions", { # Prevents intermediate caching of palettes map <- function(x, limits) { From 61f1ef6bb0899bd3a94b3d32d6ba7a0bf69c7ad7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 18 Sep 2024 11:04:03 +0200 Subject: [PATCH 08/12] fix snapshots --- tests/testthat/_snaps/stat-qq.md | 2 +- tests/testthat/test-labels.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/_snaps/stat-qq.md b/tests/testthat/_snaps/stat-qq.md index 9c943fdd29..442a5ba54c 100644 --- a/tests/testthat/_snaps/stat-qq.md +++ b/tests/testthat/_snaps/stat-qq.md @@ -14,5 +14,5 @@ Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: - ! `line.p` must be a a vector of length 2, not length 1. + ! `line.p` must be a vector of length 2, not length 1. diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R index 60f5165c1b..b852e14b20 100644 --- a/tests/testthat/test-labels.R +++ b/tests/testthat/test-labels.R @@ -124,7 +124,7 @@ test_that("plot.tag.position rejects invalid input", { ) expect_error( ggplotGrob(p + theme(plot.tag.position = c(0, 0.5, 1))), - "must have length 2" + "must be a vector of length 2" ) expect_error( ggplotGrob(p + theme(plot.tag.position = c(0, 0), plot.tag.location = "margin")), From 6f1badccab9110eec47647390af0f74721b4d9ae Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Thu, 19 Sep 2024 09:03:32 +0200 Subject: [PATCH 09/12] relax coord requirements --- R/coord-.R | 2 +- tests/testthat/_snaps/coord-cartesian.md | 2 +- tests/testthat/_snaps/coord-flip.md | 2 +- tests/testthat/_snaps/coord-map.md | 2 +- tests/testthat/_snaps/coord-transform.md | 2 +- tests/testthat/_snaps/coord_sf.md | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/coord-.R b/R/coord-.R index ab7be0aafb..32bdb963f8 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -271,6 +271,6 @@ check_coord_limits <- function( if (is.null(limits)) { return(invisible(NULL)) } - check_numeric(limits, arg = arg, call = call) + check_object(limits, is.vector, "a vector", arg = arg, call = call) check_length(limits, 2L, arg = arg, call = call) } diff --git a/tests/testthat/_snaps/coord-cartesian.md b/tests/testthat/_snaps/coord-cartesian.md index 7273730f8c..5bf397e20c 100644 --- a/tests/testthat/_snaps/coord-cartesian.md +++ b/tests/testthat/_snaps/coord-cartesian.md @@ -1,6 +1,6 @@ # cartesian coords throws error when limits are badly specified - `xlim` must be a vector, not a object. + `xlim` must be a vector, not a object. --- diff --git a/tests/testthat/_snaps/coord-flip.md b/tests/testthat/_snaps/coord-flip.md index 360c49a03f..101fb0908d 100644 --- a/tests/testthat/_snaps/coord-flip.md +++ b/tests/testthat/_snaps/coord-flip.md @@ -1,6 +1,6 @@ # flip coords throws error when limits are badly specified - `xlim` must be a vector, not a object. + `xlim` must be a vector, not a object. --- diff --git a/tests/testthat/_snaps/coord-map.md b/tests/testthat/_snaps/coord-map.md index 9e9e4f6c82..e74d005cad 100644 --- a/tests/testthat/_snaps/coord-map.md +++ b/tests/testthat/_snaps/coord-map.md @@ -1,6 +1,6 @@ # coord map throws error when limits are badly specified - `xlim` must be a vector, not a object. + `xlim` must be a vector, not a object. --- diff --git a/tests/testthat/_snaps/coord-transform.md b/tests/testthat/_snaps/coord-transform.md index cb78f0fcf6..8c4a8f21e5 100644 --- a/tests/testthat/_snaps/coord-transform.md +++ b/tests/testthat/_snaps/coord-transform.md @@ -1,6 +1,6 @@ # coord_trans() throws error when limits are badly specified - `xlim` must be a vector, not a object. + `xlim` must be a vector, not a object. --- diff --git a/tests/testthat/_snaps/coord_sf.md b/tests/testthat/_snaps/coord_sf.md index 358c9c05d3..7eb42bf074 100644 --- a/tests/testthat/_snaps/coord_sf.md +++ b/tests/testthat/_snaps/coord_sf.md @@ -21,7 +21,7 @@ # coord_sf() throws error when limits are badly specified - `xlim` must be a vector, not a object. + `xlim` must be a vector, not a object. --- From 37105af84d6c402b9a7b2b61ab7803cea2b4d835 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 20 Sep 2024 08:54:09 +0200 Subject: [PATCH 10/12] TIL: is.vector() is FALSE, whereas is_vector() is TRUE --- R/coord-.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/coord-.R b/R/coord-.R index 32bdb963f8..2b279f56ee 100644 --- a/R/coord-.R +++ b/R/coord-.R @@ -271,6 +271,6 @@ check_coord_limits <- function( if (is.null(limits)) { return(invisible(NULL)) } - check_object(limits, is.vector, "a vector", arg = arg, call = call) + check_object(limits, is_vector, "a vector", arg = arg, call = call) check_length(limits, 2L, arg = arg, call = call) } From 6849bc91d959c357bfb3db7608a31e9986e6bd4e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 30 Oct 2024 10:38:39 +0100 Subject: [PATCH 11/12] restore previous error --- R/stat-qq-line.R | 4 +++- tests/testthat/_snaps/stat-qq.md | 2 +- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index a78ee6ecb9..8133216779 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -71,7 +71,9 @@ StatQqLine <- ggproto("StatQqLine", Stat, theoretical <- inject(distribution(p = quantiles, !!!dparams)) - check_length(line.p, 2L) + if (length(line.p) != 2) { + cli::cli_abort("Cannot fit line quantiles {line.p}. {.arg line.p} must have length 2.") + } x_coords <- inject(distribution(p = line.p, !!!dparams)) y_coords <- stats::quantile(sample, line.p) diff --git a/tests/testthat/_snaps/stat-qq.md b/tests/testthat/_snaps/stat-qq.md index 442a5ba54c..3be2b1b4e4 100644 --- a/tests/testthat/_snaps/stat-qq.md +++ b/tests/testthat/_snaps/stat-qq.md @@ -14,5 +14,5 @@ Computation failed in `stat_qq_line()`. Caused by error in `compute_group()`: - ! `line.p` must be a vector of length 2, not length 1. + ! Cannot fit line quantiles 0.15. `line.p` must have length 2. From 13dd2f5bc058b4ca361ef073b28a6f27846ea3d8 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 30 Oct 2024 10:43:44 +0100 Subject: [PATCH 12/12] update snapshots --- tests/testthat/_snaps/coord-.md | 4 ++-- tests/testthat/_snaps/labels.md | 2 +- tests/testthat/_snaps/scale-date.md | 2 +- tests/testthat/_snaps/scales.md | 16 ++++++++++++++++ tests/testthat/test-scales.R | 10 ++-------- 5 files changed, 22 insertions(+), 12 deletions(-) diff --git a/tests/testthat/_snaps/coord-.md b/tests/testthat/_snaps/coord-.md index acf9ad78c6..563c7f475d 100644 --- a/tests/testthat/_snaps/coord-.md +++ b/tests/testthat/_snaps/coord-.md @@ -24,7 +24,7 @@ check_coord_limits(xlim(1, 2)) Condition Error: - ! `xlim(1, 2)` must be a vector of length 2, not a object. + ! `xlim(1, 2)` must be a vector, not a object. --- @@ -32,5 +32,5 @@ check_coord_limits(1:3) Condition Error: - ! `1:3` must be a vector of length 2, not an integer vector of length 3. + ! `1:3` must be a vector of length 2, not length 3. diff --git a/tests/testthat/_snaps/labels.md b/tests/testthat/_snaps/labels.md index 80b541e2e4..2a4bd75ff4 100644 --- a/tests/testthat/_snaps/labels.md +++ b/tests/testthat/_snaps/labels.md @@ -31,7 +31,7 @@ ggplotGrob(p + theme(plot.tag.position = c(0, 0.5, 1))) Condition Error in `theme()`: - ! A `plot.tag.position` theme setting must have length 2. + ! A `plot.tag.position` must be a vector of length 2, not length 3. --- diff --git a/tests/testthat/_snaps/scale-date.md b/tests/testthat/_snaps/scale-date.md index 9717f0f785..a2c1e51e73 100644 --- a/tests/testthat/_snaps/scale-date.md +++ b/tests/testthat/_snaps/scale-date.md @@ -6,5 +6,5 @@ --- A value was passed to a Datetime scale. - i The value was converted to a object. + i The value was converted to a object. diff --git a/tests/testthat/_snaps/scales.md b/tests/testthat/_snaps/scales.md index 40298a1836..549769419c 100644 --- a/tests/testthat/_snaps/scales.md +++ b/tests/testthat/_snaps/scales.md @@ -99,3 +99,19 @@ The `scale_name` argument of `binned_scale()` is deprecated as of ggplot2 3.5.0. +# continuous scales warn about faulty `limits` + + Code + scale_x_continuous(limits = c("A", "B")) + Condition + Error in `scale_x_continuous()`: + ! `limits` must be a vector, not a character vector. + +--- + + Code + scale_x_continuous(limits = 1:3) + Condition + Error in `scale_x_continuous()`: + ! `limits` must be a vector of length 2, not length 3. + diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index e4fa75bde8..d9286b513f 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -730,14 +730,8 @@ test_that("Discrete scales with only NAs return `na.value`", { }) test_that("continuous scales warn about faulty `limits`", { - expect_error( - scale_x_continuous(limits = c("A", "B")), - "not a character vector" - ) - expect_error( - scale_x_continuous(limits = 1:3), - "length 2, not length 3" - ) + expect_snapshot(scale_x_continuous(limits = c("A", "B")), error = TRUE) + expect_snapshot(scale_x_continuous(limits = 1:3), error = TRUE) }) test_that("discrete scales work with NAs in arbitrary positions", {