Skip to content

Commit 06ca577

Browse files
authored
Code sanitising: type checks (#5209)
* Add is_scalar_numeric * Use type checks * Import rlang types check * Increment required rlang version * Add utility for passing cli messages * write additional checks * Update checks * Accept new snapshots * ignore abort calls in standalone files * retire `obj_desc()` in favour of `obj_type_friendly()` * reimport standalone files * Use `check_data_frame()` * clean old checks * Accept new messages * Add NEWS bullet * Cover remaining checks with snapshot tests
1 parent 9503d74 commit 06ca577

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

52 files changed

+1087
-159
lines changed

DESCRIPTION

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ Imports:
3939
lifecycle (> 1.0.1),
4040
MASS,
4141
mgcv,
42-
rlang (>= 1.0.0),
42+
rlang (>= 1.1.0),
4343
scales (>= 1.2.0),
4444
stats,
4545
tibble,
@@ -93,6 +93,7 @@ Collate:
9393
'compat-plyr.R'
9494
'utilities.R'
9595
'aes.R'
96+
'utilities-checks.R'
9697
'legend-draw.R'
9798
'geom-.R'
9899
'annotation-custom.R'
@@ -183,6 +184,8 @@ Collate:
183184
'guides-grid.R'
184185
'guides-none.R'
185186
'hexbin.R'
187+
'import-standalone-obj-type.R'
188+
'import-standalone-types-check.R'
186189
'labeller.R'
187190
'labels.R'
188191
'layer.R'

NEWS.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# ggplot2 (development version)
22

3+
* Various type checks and their messages have been standardised
4+
(@teunbrand, #4834).
35
* The `layer_data()`, `layer_scales()` and `layer_grob()` now have the default
46
`plot = last_plot()` (@teunbrand, #5166).
57
* To prevent changing the plotting order, `stat_sf()` is now computed per panel

R/aes.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -115,9 +115,7 @@ new_aesthetic <- function(x, env = globalenv()) {
115115
x
116116
}
117117
new_aes <- function(x, env = globalenv()) {
118-
if (!is.list(x)) {
119-
cli::cli_abort("{.arg x} must be a list")
120-
}
118+
check_object(x, is.list, "a {.cls list}")
121119
x <- lapply(x, new_aesthetic, env = env)
122120
structure(x, class = "uneval")
123121
}

R/annotation-map.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -58,9 +58,7 @@ NULL
5858
#' }}}
5959
annotation_map <- function(map, ...) {
6060
# Get map input into correct form
61-
if (!is.data.frame(map)) {
62-
cli::cli_abort("{.arg map} must be a {.cls data.frame}")
63-
}
61+
check_data_frame(map)
6462
if (!is.null(map$lat)) map$y <- map$lat
6563
if (!is.null(map$long)) map$x <- map$long
6664
if (!is.null(map$region)) map$id <- map$region

R/annotation.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL,
4242
ymin = NULL, ymax = NULL, xend = NULL, yend = NULL, ...,
4343
na.rm = FALSE) {
4444

45-
if (is.character(geom) && geom %in% c("abline", "hline", "vline")) {
45+
if (is_string(geom, c("abline", "hline", "vline"))) {
4646
cli::cli_warn(c(
4747
"{.arg geom} must not be {.val {geom}}.",
4848
"i" = "Please use {.fn {paste0('geom_', geom)}} directly instead."

R/bench.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -15,9 +15,7 @@
1515
benchplot <- function(x) {
1616
x <- enquo(x)
1717
construct <- system.time(x <- eval_tidy(x))
18-
if (!inherits(x, "ggplot")) {
19-
cli::cli_abort("{.arg x} must be a {.cls ggplot} object")
20-
}
18+
check_inherits(x, "ggplot")
2119

2220
build <- system.time(data <- ggplot_build(x))
2321
render <- system.time(grob <- ggplot_gtable(data))

R/bin.R

Lines changed: 5 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
11
bins <- function(breaks, closed = "right",
22
fuzz = 1e-08 * stats::median(diff(breaks))) {
3-
if (!is.numeric(breaks)) {
4-
cli::cli_abort("{.arg breaks} must be a numeric vector")
5-
}
3+
check_numeric(breaks)
64
closed <- arg_match0(closed, c("right", "left"))
75

86
breaks <- sort(breaks)
@@ -56,12 +54,7 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL,
5654
cli::cli_abort("{.arg x_range} must have two elements")
5755
}
5856

59-
# if (length(x_range) == 0) {
60-
# return(bin_params(numeric()))
61-
# }
62-
if (!(is.numeric(width) && length(width) == 1)) {
63-
cli::cli_abort("{.arg width} must be a number")
64-
}
57+
check_number_decimal(width)
6558
if (width <= 0) {
6659
cli::cli_abort("{.arg binwidth} must be positive")
6760
}
@@ -115,10 +108,8 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
115108
cli::cli_abort("{.arg x_range} must have two elements")
116109
}
117110

118-
bins <- as.integer(bins)
119-
if (bins < 1) {
120-
cli::cli_abort("{.arg bins} must be 1 or greater")
121-
} else if (zero_range(x_range)) {
111+
check_number_whole(bins, min = 1)
112+
if (zero_range(x_range)) {
122113
# 0.1 is the same width as the expansion `default_expansion()` gives for 0-width data
123114
width <- 0.1
124115
} else if (bins == 1) {
@@ -136,9 +127,7 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
136127
# Compute bins ------------------------------------------------------------
137128

138129
bin_vector <- function(x, bins, weight = NULL, pad = FALSE) {
139-
if (!is_bins(bins)) {
140-
cli::cli_abort("{.arg bins} must be a {.cls ggplot2_bins} object")
141-
}
130+
check_object(bins, is_bins, "a {.cls ggplot2_bins} object")
142131

143132
if (all(is.na(x))) {
144133
return(bin_out(length(x), NA, NA, xmin = NA, xmax = NA))

R/compat-plyr.R

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -193,7 +193,7 @@ revalue <- function(x, replace) {
193193
lev[match(names(replace), lev)] <- replace
194194
levels(x) <- lev
195195
} else if (!is.null(x)) {
196-
cli::cli_abort("{.arg x} must be a factor or character vector")
196+
stop_input_type(x, "a factor or character vector")
197197
}
198198
x
199199
}
@@ -246,9 +246,7 @@ as.quoted <- function(x, env = parent.frame()) {
246246
}
247247
# round a number to a given precision
248248
round_any <- function(x, accuracy, f = round) {
249-
if (!is.numeric(x)) {
250-
cli::cli_abort("{.arg x} must be numeric")
251-
}
249+
check_numeric(x)
252250
f(x/accuracy) * accuracy
253251
}
254252

R/facet-grid-.R

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -182,10 +182,7 @@ grid_as_facets_list <- function(rows, cols) {
182182
return(facets)
183183
}
184184

185-
is_cols_vars <- is.null(cols) || is_quosures(cols)
186-
if (!is_cols_vars) {
187-
cli::cli_abort("{.arg cols} must be {.val NULL} or a {.fn vars} specification")
188-
}
185+
check_object(cols, is_quosures, "a {.fn vars} specification", allow_null = TRUE)
189186

190187
list(
191188
rows = compact_facets(as_facets_list(rows)),

R/facet-wrap.R

Lines changed: 4 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -99,12 +99,10 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
9999
strip.position <- if (switch == "x") "bottom" else "left"
100100
}
101101
strip.position <- arg_match0(strip.position, c("top", "bottom", "left", "right"))
102-
if (!(is.null(ncol) || (is_integerish(ncol, 1) && ncol > 0))) {
103-
cli::cli_abort("{.arg ncol} must be a positive scalar integer or {.val NULL}")
104-
}
105-
if (!(is.null(nrow) || (is_integerish(nrow, 1) && nrow > 0))) {
106-
cli::cli_abort("{.arg nrow} must be a positive scalar integer or {.val NULL}")
107-
}
102+
103+
check_number_whole(ncol, allow_null = TRUE, min = 1)
104+
check_number_whole(nrow, allow_null = TRUE, min = 1)
105+
108106
if (identical(dir, "v")) {
109107
# swap
110108
tmp <- ncol

R/fortify.R

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -35,7 +35,10 @@ fortify.grouped_df <- function(model, data, ...) {
3535
}
3636
#' @export
3737
fortify.default <- function(model, data, ...) {
38-
msg <- glue("{{.arg data}} must be a {{.cls data.frame}}, or an object coercible by `fortify()`, not {obj_desc(model)}.")
38+
msg <- glue(
39+
"{{.arg data}} must be a {{.cls data.frame}}, ",
40+
"or an object coercible by `fortify()`, not {obj_type_friendly(model)}."
41+
)
3942
if (inherits(model, "uneval")) {
4043
msg <- c(
4144
msg,

R/geom-.R

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
#' @include legend-draw.R
2+
#' @include utilities-checks.R
23
NULL
34

45
#' @section Geoms:

R/geom-map.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -97,9 +97,7 @@ geom_map <- function(mapping = NULL, data = NULL,
9797
show.legend = NA,
9898
inherit.aes = TRUE) {
9999
# Get map input into correct form
100-
if (!is.data.frame(map)) {
101-
cli::cli_abort("{.arg map} must be a {.cls data.frame}")
102-
}
100+
check_data_frame(map)
103101
if (!is.null(map$lat)) map$y <- map$lat
104102
if (!is.null(map$long)) map$x <- map$long
105103
if (!is.null(map$region)) map$id <- map$region

R/geom-raster.R

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -18,12 +18,8 @@ geom_raster <- function(mapping = NULL, data = NULL,
1818
show.legend = NA,
1919
inherit.aes = TRUE)
2020
{
21-
if (!is_scalar_double(hjust)) {
22-
cli::cli_abort("{.arg hjust} must be a number")
23-
}
24-
if (!is_scalar_double(vjust)) {
25-
cli::cli_abort("{.arg vjust} must be a number")
26-
}
21+
check_number_decimal(hjust)
22+
check_number_decimal(vjust)
2723

2824
layer(
2925
data = data,

R/geom-rug.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -91,9 +91,7 @@ GeomRug <- ggproto("GeomRug", Geom,
9191
draw_panel = function(self, data, panel_params, coord, lineend = "butt",
9292
sides = "bl", outside = FALSE, length = unit(0.03, "npc")) {
9393
data <- check_linewidth(data, snake_class(self))
94-
if (!inherits(length, "unit")) {
95-
cli::cli_abort("{.arg length} must be a {.cls unit} object.")
96-
}
94+
check_inherits(length, "unit")
9795
rugs <- list()
9896
data <- coord$transform(data, panel_params)
9997

R/ggproto.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -78,9 +78,7 @@ ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) {
7878

7979
super <- find_super()
8080
if (!is.null(super)) {
81-
if (!is.ggproto(super)) {
82-
cli::cli_abort("{.arg _inherit} must be a {.cls ggproto} object.")
83-
}
81+
check_object(super, is.ggproto, "a {.cls ggproto} object", arg = "_inherit")
8482
e$super <- find_super
8583
class(e) <- c(`_class`, class(super))
8684
} else {

R/guides-axis.R

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -386,9 +386,7 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) {
386386
}
387387

388388
# it is not worth the effort to align upside-down labels properly
389-
if (angle > 90 || angle < -90) {
390-
cli::cli_abort("{.arg angle} must be between 90 and -90")
391-
}
389+
check_number_decimal(angle, min = -90, max = 90)
392390

393391
if (axis_position == "bottom") {
394392
element_text(

0 commit comments

Comments
 (0)