From 8bb36f0369ea7980086906d97b0cb24c26efdf5b Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Mon, 9 Sep 2019 14:26:43 +0200 Subject: [PATCH 1/5] Use abort() instead of stop() --- R/aes-calculated.r | 4 ++-- R/aes.r | 9 ++++----- R/annotation-custom.r | 3 +-- R/annotation-map.r | 4 ++-- R/annotation-raster.r | 3 +-- R/annotation.r | 2 +- R/autolayer.r | 4 ++-- R/autoplot.r | 4 ++-- R/axis-secondary.R | 6 +++--- R/bench.r | 2 +- R/bin.R | 18 +++++++++--------- R/compat-plyr.R | 8 ++++---- R/coord-.r | 10 +++++----- R/coord-sf.R | 14 ++++---------- R/facet-.r | 23 +++++++++-------------- R/facet-grid-.r | 23 +++++++++++------------ R/facet-wrap.r | 4 ++-- R/fortify.r | 6 +++--- R/geom-.r | 9 ++++----- R/geom-boxplot.r | 5 +---- R/geom-hex.r | 4 ++-- R/geom-jitter.r | 2 +- R/geom-label.R | 4 ++-- R/geom-map.r | 4 ++-- R/geom-path.r | 6 ++---- R/geom-point.r | 14 ++++++-------- R/geom-polygon.r | 2 +- R/geom-raster.r | 6 +++--- R/geom-ribbon.r | 4 ++-- R/geom-rug.r | 2 +- R/geom-sf.R | 8 ++++---- R/geom-text.r | 2 +- R/geom-violin.r | 4 +++- R/ggproto.r | 11 +++++------ R/guide-colorbar.r | 4 ++-- R/guide-legend.r | 7 ++----- R/guides-.r | 6 +++--- R/guides-axis.r | 4 ++-- R/labeller.r | 8 ++++---- R/layer.r | 23 +++++++++++------------ R/layout.R | 2 +- R/limits.r | 10 +++++----- R/margins.R | 2 +- R/performance.R | 8 ++++---- R/plot-build.r | 8 ++++---- R/plot-construction.r | 10 +++------- R/plot.r | 4 ++-- R/position-.r | 2 +- R/position-collide.r | 2 +- R/position-jitterdodge.R | 2 +- R/quick-plot.r | 2 +- R/save.r | 12 ++++++------ R/scale-.r | 38 +++++++++++++++++++------------------- R/scale-colour.r | 4 ++-- R/scale-expansion.r | 14 ++++++-------- R/scale-linetype.r | 2 +- R/scale-manual.r | 4 ++-- R/scale-shape.r | 2 +- R/scale-view.r | 4 ++-- R/stat-.r | 2 +- R/stat-bin.r | 9 ++++----- R/stat-bin2d.r | 4 ++-- R/stat-bindot.r | 2 +- R/stat-count.r | 4 ++-- R/stat-qq-line.R | 7 +++---- R/stat-qq.r | 4 ++-- R/stat-summary.r | 2 +- R/stat-ydensity.r | 4 ++-- R/summarise-plot.R | 6 +++--- R/theme-current.R | 2 +- R/theme-elements.r | 8 ++++---- R/theme.r | 13 ++++++------- R/utilities-break.r | 6 +++--- R/utilities-grid.r | 4 ++-- R/utilities-matrix.r | 2 +- R/utilities.r | 21 ++++++++++----------- 76 files changed, 241 insertions(+), 277 deletions(-) diff --git a/R/aes-calculated.r b/R/aes-calculated.r index 95b9390bba..d07ade82ba 100644 --- a/R/aes-calculated.r +++ b/R/aes-calculated.r @@ -51,7 +51,7 @@ is_calculated <- function(x) { } else if (is.pairlist(x)) { FALSE } else { - stop("Unknown input:", class(x)[1]) + abort(paste0("Unknown input:", class(x)[1])) } } @@ -80,7 +80,7 @@ strip_dots <- function(expr) { # For list of aesthetics lapply(expr, strip_dots) } else { - stop("Unknown input:", class(expr)[1]) + abort(paste0("Unknown input:", class(expr)[1])) } } diff --git a/R/aes.r b/R/aes.r index ef6f9dd602..f9dd9a44f4 100644 --- a/R/aes.r +++ b/R/aes.r @@ -102,7 +102,7 @@ new_aesthetic <- function(x, env = globalenv()) { x } new_aes <- function(x, env = globalenv()) { - stopifnot(is.list(x)) + if (!is.list(x)) abort("`x` must be a list") x <- lapply(x, new_aesthetic, env = env) structure(x, class = "uneval") } @@ -248,8 +248,7 @@ aes_ <- function(x, y, ...) { } else if (is.call(x) || is.name(x) || is.atomic(x)) { new_aesthetic(x, caller_env) } else { - stop("Aesthetic must be a one-sided formula, call, name, or constant.", - call. = FALSE) + abort("Aesthetic must be a one-sided formula, call, name, or constant.") } } mapping <- lapply(mapping, as_quosure_aes) @@ -309,7 +308,7 @@ aes_auto <- function(data = NULL, ...) { # detect names of data if (is.null(data)) { - stop("aes_auto requires data.frame or names of data.frame.") + abort("aes_auto requires data.frame or names of data.frame.") } else if (is.data.frame(data)) { vars <- names(data) } else { @@ -376,7 +375,7 @@ alternative_aes_extract_usage <- function(x) { } else if (is_call(x, "$")) { as.character(x[[3]]) } else { - stop("Don't know how to get alternative usage for `", format(x), "`", call. = FALSE) + abort(paste0("Don't know how to get alternative usage for `", format(x), "`")) } } diff --git a/R/annotation-custom.r b/R/annotation-custom.r index c27f7c7d61..2f8a0f0098 100644 --- a/R/annotation-custom.r +++ b/R/annotation-custom.r @@ -71,8 +71,7 @@ GeomCustomAnn <- ggproto("GeomCustomAnn", Geom, draw_panel = function(data, panel_params, coord, grob, xmin, xmax, ymin, ymax) { if (!inherits(coord, "CoordCartesian")) { - stop("annotation_custom only works with Cartesian coordinates", - call. = FALSE) + abort("annotation_custom only works with Cartesian coordinates") } corners <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2) data <- coord$transform(corners, panel_params) diff --git a/R/annotation-map.r b/R/annotation-map.r index 85a3e3e5bd..fde5b1cb84 100644 --- a/R/annotation-map.r +++ b/R/annotation-map.r @@ -31,11 +31,11 @@ NULL #' } annotation_map <- function(map, ...) { # Get map input into correct form - stopifnot(is.data.frame(map)) + if (!is.data.frame(map)) abort("`map` must be a data.frame") if (!is.null(map$lat)) map$y <- map$lat if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region - stopifnot(all(c("x", "y", "id") %in% names(map))) + if (!all(c("x", "y", "id") %in% names(map))) abort("`map`must have the columns `x`, `y`, and `id`") layer( data = dummy_data(), diff --git a/R/annotation-raster.r b/R/annotation-raster.r index 1851831299..dcc057c90d 100644 --- a/R/annotation-raster.r +++ b/R/annotation-raster.r @@ -73,8 +73,7 @@ GeomRasterAnn <- ggproto("GeomRasterAnn", Geom, draw_panel = function(data, panel_params, coord, raster, xmin, xmax, ymin, ymax, interpolate = FALSE) { if (!inherits(coord, "CoordCartesian")) { - stop("annotation_raster only works with Cartesian coordinates", - call. = FALSE) + abort("annotation_raster only works with Cartesian coordinates") } corners <- new_data_frame(list(x = c(xmin, xmax), y = c(ymin, ymax)), n = 2) data <- coord$transform(corners, panel_params) diff --git a/R/annotation.r b/R/annotation.r index 59c241ab4e..1b60408d90 100644 --- a/R/annotation.r +++ b/R/annotation.r @@ -58,7 +58,7 @@ annotate <- function(geom, x = NULL, y = NULL, xmin = NULL, xmax = NULL, bad <- lengths != 1L details <- paste(names(aesthetics)[bad], " (", lengths[bad], ")", sep = "", collapse = ", ") - stop("Unequal parameter lengths: ", details, call. = FALSE) + abort(paste0("Unequal parameter lengths: ", details)) } data <- new_data_frame(position, n = n) diff --git a/R/autolayer.r b/R/autolayer.r index 0f32c8f3c3..5af86fd2c1 100644 --- a/R/autolayer.r +++ b/R/autolayer.r @@ -15,6 +15,6 @@ autolayer <- function(object, ...) { #' @export autolayer.default <- function(object, ...) { - stop("Objects of type ", paste(class(object), collapse = "/"), - " not supported by autolayer.", call. = FALSE) + abort(paste0("Objects of type ", paste(class(object), collapse = "/"), + " not supported by autolayer.")) } diff --git a/R/autoplot.r b/R/autoplot.r index c2e13a606f..16558cc928 100644 --- a/R/autoplot.r +++ b/R/autoplot.r @@ -15,7 +15,7 @@ autoplot <- function(object, ...) { #' @export autoplot.default <- function(object, ...) { - stop("Objects of type ", paste(class(object), collapse = "/"), - " not supported by autoplot.", call. = FALSE) + abort(paste0("Objects of type ", paste(class(object), collapse = "/"), + " not supported by autoplot.")) } diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 0d7f6df1a3..13b2d5c7e8 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -105,7 +105,7 @@ is.sec_axis <- function(x) { set_sec_axis <- function(sec.axis, scale) { if (!is.waive(sec.axis)) { if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis) - if (!is.sec_axis(sec.axis)) stop("Secondary axes must be specified using 'sec_axis()'") + if (!is.sec_axis(sec.axis)) abort("Secondary axes must be specified using 'sec_axis()'") scale$secondary.axis <- sec.axis } return(scale) @@ -143,7 +143,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # Inherit settings from the primary axis/scale init = function(self, scale) { if (self$empty()) return() - if (!is.function(self$trans)) stop("transformation for secondary axes must be a function", call. = FALSE) + if (!is.function(self$trans)) abort("transformation for secondary axes must be a function") if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name if (is.derived(self$breaks)) self$breaks <- scale$breaks if (is.waive(self$breaks)) self$breaks <- scale$trans$breaks @@ -164,7 +164,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, # Test for monotonicity if (length(unique(sign(diff(full_range)))) != 1) - stop("transformation for secondary axes must be monotonic") + abort("transformation for secondary axes must be monotonic") }, break_info = function(self, range, scale) { diff --git a/R/bench.r b/R/bench.r index 60ab4ccb32..d394bb334f 100644 --- a/R/bench.r +++ b/R/bench.r @@ -15,7 +15,7 @@ benchplot <- function(x) { x <- enquo(x) construct <- system.time(x <- eval_tidy(x)) - stopifnot(inherits(x, "ggplot")) + if (!inherits(x, "ggplot")) abort("`x` must be a ggplot object") build <- system.time(data <- ggplot_build(x)) render <- system.time(grob <- ggplot_gtable(data)) diff --git a/R/bin.R b/R/bin.R index 55d898c846..a4a596dc67 100644 --- a/R/bin.R +++ b/R/bin.R @@ -1,6 +1,6 @@ bins <- function(breaks, closed = c("right", "left"), fuzz = 1e-08 * stats::median(diff(breaks))) { - stopifnot(is.numeric(breaks)) + if (!is.numeric(breaks)) abort("`breaks` must be a numeric vector") closed <- match.arg(closed) breaks <- sort(breaks) @@ -50,18 +50,18 @@ bin_breaks <- function(breaks, closed = c("right", "left")) { bin_breaks_width <- function(x_range, width = NULL, center = NULL, boundary = NULL, closed = c("right", "left")) { - stopifnot(length(x_range) == 2) + if (length(x_range) != 2) abort("`x_range` must have two elements") # if (length(x_range) == 0) { # return(bin_params(numeric())) # } - stopifnot(is.numeric(width), length(width) == 1) + if (!(is.numeric(width) && length(width) == 1)) abort("`width` must be a numeric scalar") if (width <= 0) { - stop("`binwidth` must be positive", call. = FALSE) + abort("`binwidth` must be positive") } if (!is.null(boundary) && !is.null(center)) { - stop("Only one of 'boundary' and 'center' may be specified.") + abort("Only one of 'boundary' and 'center' may be specified.") } else if (is.null(boundary)) { if (is.null(center)) { # If neither edge nor center given, compute both using tile layer's @@ -88,7 +88,7 @@ bin_breaks_width <- function(x_range, width = NULL, center = NULL, breaks <- seq(origin, max_x, width) if (length(breaks) > 1e6) { - stop("The number of histogram bins must be less than 1,000,000.\nDid you make `binwidth` too small?", call. = FALSE) + abort("The number of histogram bins must be less than 1,000,000.\nDid you make `binwidth` too small?") } bin_breaks(breaks, closed = closed) @@ -96,11 +96,11 @@ 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")) { - stopifnot(length(x_range) == 2) + if (length(x_range) != 2) abort("`x_range` must have two elements") bins <- as.integer(bins) if (bins < 1) { - stop("Need at least one bin.", call. = FALSE) + abort("Need at least one bin.") } else if (zero_range(x_range)) { # 0.1 is the same width as the expansion `default_expansion()` gives for 0-width data width <- 0.1 @@ -119,7 +119,7 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL, # Compute bins ------------------------------------------------------------ bin_vector <- function(x, bins, weight = NULL, pad = FALSE) { - stopifnot(is_bins(bins)) + if (!is_bins(bins)) abort("`bins` must be a ggplot2_bins object") if (all(is.na(x))) { return(bin_out(length(x), NA, NA, xmin = NA, xmax = NA)) diff --git a/R/compat-plyr.R b/R/compat-plyr.R index 6ec0ae6b06..ab1b16fe70 100644 --- a/R/compat-plyr.R +++ b/R/compat-plyr.R @@ -19,7 +19,7 @@ unrowname <- function(x) { } else if (is.matrix(x)) { dimnames(x)[1] <- list(NULL) } else { - stop("Can only remove rownames from data.frame and matrix objects", call. = FALSE) + abort("Can only remove rownames from data.frame and matrix objects") } x } @@ -193,7 +193,7 @@ revalue <- function(x, replace) { lev[match(names(replace), lev)] <- replace levels(x) <- lev } else if (!is.null(x)) { - stop("x is not a factor or character vector", call. = FALSE) + abort("x is not a factor or character vector") } x } @@ -239,14 +239,14 @@ as.quoted <- function(x, env = parent.frame()) { } else if (is.call(x)) { as.list(x)[-1] } else { - stop("Only knows how to quote characters, calls, and formula", call. = FALSE) + abort("Only knows how to quote characters, calls, and formula") } attributes(x) <- list(env = env, class = 'quoted') x } # round a number to a given precision round_any <- function(x, accuracy, f = round) { - if (!is.numeric(x)) stop("x must be numeric", call. = FALSE) + if (!is.numeric(x)) abort("`x`` must be numeric") f(x/accuracy) * accuracy } #' Bind data frames together by common column names diff --git a/R/coord-.r b/R/coord-.r index e2ea1a025d..a3b547cfef 100644 --- a/R/coord-.r +++ b/R/coord-.r @@ -64,27 +64,27 @@ Coord <- ggproto("Coord", render_fg = function(panel_params, theme) element_render(theme, "panel.border"), render_bg = function(panel_params, theme) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, render_axis_h = function(panel_params, theme) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, render_axis_v = function(panel_params, theme) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, # transform range given in transformed coordinates # back into range in given in (possibly scale-transformed) # data coordinates backtransform_range = function(self, panel_params) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, # return range stored in panel_params range = function(panel_params) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, setup_panel_params = function(scale_x, scale_y, params = list()) { diff --git a/R/coord-sf.R b/R/coord-sf.R index b73227c7e7..2d194c9467 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -84,7 +84,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, } if (length(x_labels) != length(x_breaks)) { - stop("Breaks and labels along x direction are different lengths", call. = FALSE) + abort("Breaks and labels along x direction are different lengths") } graticule$degree_label[graticule$type == "E"] <- x_labels @@ -109,7 +109,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, } if (length(y_labels) != length(y_breaks)) { - stop("Breaks and labels along y direction are different lengths", call. = FALSE) + abort("Breaks and labels along y direction are different lengths") } graticule$degree_label[graticule$type == "N"] <- y_labels @@ -434,20 +434,14 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, if (is.character(label_axes)) { label_axes <- parse_axes_labeling(label_axes) } else if (!is.list(label_axes)) { - stop( - "Panel labeling format not recognized.", - call. = FALSE - ) + abort("Panel labeling format not recognized.") label_axes <- list(left = "N", bottom = "E") } if (is.character(label_graticule)) { label_graticule <- unlist(strsplit(label_graticule, "")) } else { - stop( - "Graticule labeling format not recognized.", - call. = FALSE - ) + abort("Graticule labeling format not recognized.") label_graticule <- "" } diff --git a/R/facet-.r b/R/facet-.r index 2096b5f2cd..94f185f819 100644 --- a/R/facet-.r +++ b/R/facet-.r @@ -83,10 +83,10 @@ Facet <- ggproto("Facet", NULL, params = list(), compute_layout = function(data, params) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, map_data = function(data, layout, params) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, init_scales = function(layout, x_scale = NULL, y_scale = NULL, params) { scales <- list() @@ -125,7 +125,7 @@ Facet <- ggproto("Facet", NULL, rep(list(zeroGrob()), length(unique(layout$PANEL))) }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, draw_labels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, labels, params) { panel_dim <- find_panel(panels) @@ -276,7 +276,7 @@ df.grid <- function(a, b) { as_facets_list <- function(x) { if (inherits(x, "uneval")) { - stop("Please use `vars()` to supply facet variables", call. = FALSE) + abort("Please use `vars()` to supply facet variables") } if (is_quosures(x)) { x <- quos_auto_name(x) @@ -446,11 +446,7 @@ check_layout <- function(x) { return() } - stop( - "Facet layout has bad format. ", - "It must contain columns 'PANEL', 'SCALE_X', and 'SCALE_Y'", - call. = FALSE - ) + abort("Facet layout has bad format. It must contain columns 'PANEL', 'SCALE_X', and 'SCALE_Y'") } @@ -541,12 +537,11 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) { missing_txt <- vapply(missing, var_list, character(1)) name <- c("Plot", paste0("Layer ", seq_len(length(data) - 1))) - stop( + abort(paste0( "At least one layer must contain all faceting variables: ", var_list(names(vars)), ".\n", - paste0("* ", name, " is missing ", missing_txt, collapse = "\n"), - call. = FALSE - ) + paste0("* ", name, " is missing ", missing_txt, collapse = "\n") + )) } base <- unique(rbind_dfs(values[has_all])) @@ -567,7 +562,7 @@ combine_vars <- function(data, env = emptyenv(), vars = NULL, drop = TRUE) { } if (empty(base)) { - stop("Faceting variables must have at least one value", call. = FALSE) + abort("Faceting variables must have at least one value") } base diff --git a/R/facet-grid-.r b/R/facet-grid-.r index 6c0d0b2224..a4a774537f 100644 --- a/R/facet-grid-.r +++ b/R/facet-grid-.r @@ -32,9 +32,9 @@ NULL #' one with `vars(cyl, am)`. Each output #' column gets displayed as one separate line in the strip #' label. This function should inherit from the "labeller" S3 class -#' for compatibility with [labeller()]. You can use different labeling -#' functions for different kind of labels, for example use [label_parsed()] for -#' formatting facet labels. [label_value()] is used by default, +#' for compatibility with [labeller()]. You can use different labeling +#' functions for different kind of labels, for example use [label_parsed()] for +#' formatting facet labels. [label_value()] is used by default, #' check it for more details and pointers to other options. #' @param as.table If `TRUE`, the default, the facets are laid out like #' a table with highest values at the bottom-right. If `FALSE`, the @@ -136,7 +136,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed", ) if (!is.null(switch) && !switch %in% c("both", "x", "y")) { - stop("switch must be either 'both', 'x', or 'y'", call. = FALSE) + abort("switch must be either 'both', 'x', or 'y'") } facets_list <- grid_as_facets_list(rows, cols) @@ -157,12 +157,12 @@ grid_as_facets_list <- function(rows, cols) { is_rows_vars <- is.null(rows) || is_quosures(rows) if (!is_rows_vars) { if (!is.null(cols)) { - stop("`rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list", call. = FALSE) + abort("`rows` must be `NULL` or a `vars()` list if `cols` is a `vars()` list") } # For backward-compatibility facets_list <- as_facets_list(rows) if (length(facets_list) > 2L) { - stop("A grid facet specification can't have more than two dimensions", call. = FALSE) + abort("A grid facet specification can't have more than two dimensions") } # Fill with empty quosures facets <- list(rows = quos(), cols = quos()) @@ -173,7 +173,7 @@ grid_as_facets_list <- function(rows, cols) { is_cols_vars <- is.null(cols) || is_quosures(cols) if (!is_cols_vars) { - stop("`cols` must be `NULL` or a `vars()` specification", call. = FALSE) + abort("`cols` must be `NULL` or a `vars()` specification") } list( @@ -195,11 +195,10 @@ FacetGrid <- ggproto("FacetGrid", Facet, dups <- intersect(names(rows), names(cols)) if (length(dups) > 0) { - stop( + abort(paste0( "Faceting variables can only appear in row or cols, not both.\n", - "Problems: ", paste0(dups, collapse = "'"), - call. = FALSE - ) + "Problems: ", paste0(dups, collapse = "'") + )) } base_rows <- combine_vars(data, params$plot_env, rows, drop = params$drop) @@ -287,7 +286,7 @@ FacetGrid <- ggproto("FacetGrid", Facet, }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - stop(snake_class(coord), " doesn't support free scales", call. = FALSE) + abort(paste0(snake_class(coord), " doesn't support free scales")) } cols <- which(layout$ROW == 1) diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 6ab5904de5..b61f1253d9 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -211,7 +211,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - stop(snake_class(coord), " doesn't support free scales", call. = FALSE) + abort(paste0(snake_class(coord), " doesn't support free scales")) } if (inherits(coord, "CoordFlip")) { @@ -462,7 +462,7 @@ wrap_dims <- function(n, nrow = NULL, ncol = NULL) { } else if (is.null(nrow)) { nrow <- ceiling(n / ncol) } - stopifnot(nrow * ncol >= n) + if (nrow * ncol < n) abort("the given dimensions cannot hold all panels") c(nrow, ncol) } diff --git a/R/fortify.r b/R/fortify.r index cf35a403bf..779b2dc552 100644 --- a/R/fortify.r +++ b/R/fortify.r @@ -18,7 +18,7 @@ fortify.tbl_df <- function(model, data, ...) model #' @export fortify.tbl <- function(model, data, ...) { if (!requireNamespace("dplyr", quietly = TRUE)) { - stop("dplyr must be installed to work with tbl objects", call. = FALSE) + abort("dplyr must be installed to work with tbl objects") } dplyr::collect(model) } @@ -32,7 +32,7 @@ fortify.formula <- function(model, data, ...) as_function(model) #' @export fortify.grouped_df <- function(model, data, ...) { if (!requireNamespace("dplyr", quietly = TRUE)) { - stop("dplyr must be installed to work with grouped_df objects", call. = FALSE) + abort("dplyr must be installed to work with grouped_df objects") } model$.group <- dplyr::group_indices(model) model @@ -49,5 +49,5 @@ fortify.default <- function(model, data, ...) { "Did you accidentally pass `aes()` to the `data` argument?" ) } - stop(msg, call. = FALSE) + abort(msg) } diff --git a/R/geom-.r b/R/geom-.r index bca1b57ded..342d469b44 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -101,7 +101,7 @@ Geom <- ggproto("Geom", }, draw_group = function(self, data, panel_params, coord) { - stop("Not implemented") + abort("Not implemented") }, setup_params = function(data, params) params, @@ -184,9 +184,8 @@ check_aesthetics <- function(x, n) { return() } - stop( + abort(paste0( "Aesthetics must be either length 1 or the same as the data (", n, "): ", - paste(names(which(!good)), collapse = ", "), - call. = FALSE - ) + paste(names(which(!good)), collapse = ", ") + )) } diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 246a0a13f9..036a5e4271 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -202,10 +202,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom, # this may occur when using geom_boxplot(stat = "identity") if (nrow(data) != 1) { - stop( - "Can't draw more than one boxplot per group. Did you forget aes(group = ...)?", - call. = FALSE - ) + abort("Can't draw more than one boxplot per group. Did you forget aes(group = ...)?") } common <- list( diff --git a/R/geom-hex.r b/R/geom-hex.r index e669914264..683109eab2 100644 --- a/R/geom-hex.r +++ b/R/geom-hex.r @@ -56,7 +56,7 @@ geom_hex <- function(mapping = NULL, data = NULL, GeomHex <- ggproto("GeomHex", Geom, draw_group = function(data, panel_params, coord) { if (!inherits(coord, "CoordCartesian")) { - stop("geom_hex() only works with Cartesian coordinates", call. = FALSE) + abort("geom_hex() only works with Cartesian coordinates") } coords <- coord$transform(data, panel_params) @@ -94,7 +94,7 @@ GeomHex <- ggproto("GeomHex", Geom, # @param gp graphical parameters # @keyword internal hexGrob <- function(x, y, size = rep(1, length(x)), gp = gpar()) { - stopifnot(length(y) == length(x)) + if (length(y) != length(x)) abort("`x` and `y` must have the same length") dx <- resolution(x, FALSE) dy <- resolution(y, FALSE) / sqrt(3) / 2 * 1.15 diff --git a/R/geom-jitter.r b/R/geom-jitter.r index 3864090fdb..60343aee3c 100644 --- a/R/geom-jitter.r +++ b/R/geom-jitter.r @@ -39,7 +39,7 @@ geom_jitter <- function(mapping = NULL, data = NULL, inherit.aes = TRUE) { if (!missing(width) || !missing(height)) { if (!missing(position)) { - stop("You must specify either `position` or `width`/`height`.", call. = FALSE) + abort("You must specify either `position` or `width`/`height`.") } position <- position_jitter(width = width, height = height) diff --git a/R/geom-label.R b/R/geom-label.R index 4987e4b420..dffff0497f 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -17,7 +17,7 @@ geom_label <- function(mapping = NULL, data = NULL, inherit.aes = TRUE) { if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { - stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE) + abort("You must specify either `position` or `nudge_x`/`nudge_y`.") } position <- position_nudge(nudge_x, nudge_y) @@ -109,7 +109,7 @@ labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), default.units = "npc", name = NULL, text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) { - stopifnot(length(label) == 1) + if (length(label) != 1) abort("label must be of length 1") if (!is.unit(x)) x <- unit(x, default.units) diff --git a/R/geom-map.r b/R/geom-map.r index cc77923621..095362571e 100644 --- a/R/geom-map.r +++ b/R/geom-map.r @@ -67,11 +67,11 @@ geom_map <- function(mapping = NULL, data = NULL, show.legend = NA, inherit.aes = TRUE) { # Get map input into correct form - stopifnot(is.data.frame(map)) + if (!is.data.frame(map)) abort("`map` must be a data.frame") if (!is.null(map$lat)) map$y <- map$lat if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region - stopifnot(all(c("x", "y", "id") %in% names(map))) + if (!all(c("x", "y", "id") %in% names(map))) abort("`map` must have the columns `x`, `y`, and `id`") layer( data = data, diff --git a/R/geom-path.r b/R/geom-path.r index f703809708..0a5835a5d0 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -170,9 +170,7 @@ GeomPath <- ggproto("GeomPath", Geom, solid_lines <- all(attr$solid) constant <- all(attr$constant) if (!solid_lines && !constant) { - stop("geom_path: If you are using dotted or dashed lines", - ", colour, size and linetype must be constant over the line", - call. = FALSE) + abort("geom_path: If you are using dotted or dashed lines, colour, size and linetype must be constant over the line") } # Work out grouping variables for grobs @@ -324,7 +322,7 @@ stairstep <- function(data, direction = "hv") { xs <- rep(1:(n-1), each = 2) ys <- rep(1:n, each = 2) } else { - stop("Parameter `direction` is invalid.") + abort("Parameter `direction` is invalid.") } if (direction == "mid") { diff --git a/R/geom-point.r b/R/geom-point.r index 922b19170a..b2286f03f9 100644 --- a/R/geom-point.r +++ b/R/geom-point.r @@ -187,12 +187,11 @@ translate_shape_string <- function(shape_string) { sprintf("\n* ... and %d more problem%s", n_bad - 5, ifelse(n_bad > 6, "s", "")) } - stop( + abort(paste0( "Can't find shape name:", collapsed_names, - more_problems, - call. = FALSE - ) + more_problems + )) } if (any(nonunique_strings)) { @@ -214,12 +213,11 @@ translate_shape_string <- function(shape_string) { sprintf("\n* ... and %d more problem%s", n_bad - 5, ifelse(n_bad > 6, "s", "")) } - stop( + abort(paste0( "Shape names must be unambiguous:", collapsed_names, - more_problems, - call. = FALSE - ) + more_problems + )) } unname(pch_table[shape_match]) diff --git a/R/geom-polygon.r b/R/geom-polygon.r index f8ed81bae9..9b5f1bb291 100644 --- a/R/geom-polygon.r +++ b/R/geom-polygon.r @@ -137,7 +137,7 @@ GeomPolygon <- ggproto("GeomPolygon", Geom, ) } else { if (utils::packageVersion('grid') < "3.6") { - stop("Polygons with holes requires R 3.6 or above", call. = FALSE) + abort("Polygons with holes requires R 3.6 or above") } # Sort by group to make sure that colors, fill, etc. come in same order munched <- munched[order(munched$group, munched$subgroup), ] diff --git a/R/geom-raster.r b/R/geom-raster.r index 37828083ee..62a3c680e5 100644 --- a/R/geom-raster.r +++ b/R/geom-raster.r @@ -18,8 +18,8 @@ geom_raster <- function(mapping = NULL, data = NULL, show.legend = NA, inherit.aes = TRUE) { - stopifnot(is.numeric(hjust), length(hjust) == 1) - stopifnot(is.numeric(vjust), length(vjust) == 1) + if (!(is.numeric(hjust) && length(hjust) == 1)) abort("`hjust` must be a numeric scalar") + if (!(is.numeric(vjust) && length(vjust) == 1)) abort("`vjust` must be a numeric scalar") layer( data = data, @@ -82,7 +82,7 @@ GeomRaster <- ggproto("GeomRaster", Geom, draw_panel = function(data, panel_params, coord, interpolate = FALSE, hjust = 0.5, vjust = 0.5) { if (!inherits(coord, "CoordCartesian")) { - stop("geom_raster only works with Cartesian coordinates", call. = FALSE) + abort("geom_raster only works with Cartesian coordinates") } data <- coord$transform(data, panel_params) diff --git a/R/geom-ribbon.r b/R/geom-ribbon.r index 17df0ed118..b6822ca343 100644 --- a/R/geom-ribbon.r +++ b/R/geom-ribbon.r @@ -65,7 +65,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, setup_data = function(data, params) { if (is.null(data$ymin) && is.null(data$ymax)) { - stop("Either ymin or ymax must be given as an aesthetic.", call. = FALSE) + abort("Either ymin or ymax must be given as an aesthetic.") } data <- data[order(data$PANEL, data$group, data$x), , drop = FALSE] data$y <- data$ymin %||% data$ymax @@ -85,7 +85,7 @@ GeomRibbon <- ggproto("GeomRibbon", Geom, # Check that aesthetics are constant aes <- unique(data[c("colour", "fill", "size", "linetype", "alpha")]) if (nrow(aes) > 1) { - stop("Aesthetics can not vary with a ribbon") + abort("Aesthetics can not vary with a ribbon") } aes <- as.list(aes) diff --git a/R/geom-rug.r b/R/geom-rug.r index 5c226af11e..66861c42f7 100644 --- a/R/geom-rug.r +++ b/R/geom-rug.r @@ -87,7 +87,7 @@ GeomRug <- ggproto("GeomRug", Geom, draw_panel = function(data, panel_params, coord, sides = "bl", outside = FALSE, length = unit(0.03, "npc")) { if (!inherits(length, "unit")) { - stop("'length' must be a 'unit' object.", call. = FALSE) + abort("'length' must be a 'unit' object.") } rugs <- list() data <- coord$transform(data, panel_params) diff --git a/R/geom-sf.R b/R/geom-sf.R index cecab0b127..1bb1494a24 100644 --- a/R/geom-sf.R +++ b/R/geom-sf.R @@ -98,11 +98,11 @@ GeomSf <- ggproto("GeomSf", Geom, ), non_missing_aes = c("size", "shape", "colour"), - + draw_panel = function(data, panel_params, coord, legend = NULL, lineend = "butt", linejoin = "round", linemitre = 10) { if (!inherits(coord, "CoordSf")) { - stop("geom_sf() must be used with coord_sf()", call. = FALSE) + abort("geom_sf() must be used with coord_sf()") } # Need to refactor this to generate one grob per geometry type @@ -210,7 +210,7 @@ geom_sf_label <- function(mapping = aes(), data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { - stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE) + abort("Specify either `position` or `nudge_x`/`nudge_y`") } position <- position_nudge(nudge_x, nudge_y) @@ -254,7 +254,7 @@ geom_sf_text <- function(mapping = aes(), data = NULL, if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { - stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE) + abort("You must specify either `position` or `nudge_x`/`nudge_y`.") } position <- position_nudge(nudge_x, nudge_y) diff --git a/R/geom-text.r b/R/geom-text.r index 404a6f2aec..48721cf64d 100644 --- a/R/geom-text.r +++ b/R/geom-text.r @@ -136,7 +136,7 @@ geom_text <- function(mapping = NULL, data = NULL, { if (!missing(nudge_x) || !missing(nudge_y)) { if (!missing(position)) { - stop("You must specify either `position` or `nudge_x`/`nudge_y`.", call. = FALSE) + abort("You must specify either `position` or `nudge_x`/`nudge_y`.") } position <- position_nudge(nudge_x, nudge_y) diff --git a/R/geom-violin.r b/R/geom-violin.r index 5a6be2add9..fcbe9d2e75 100644 --- a/R/geom-violin.r +++ b/R/geom-violin.r @@ -130,7 +130,9 @@ GeomViolin <- ggproto("GeomViolin", Geom, # Draw quantiles if requested, so long as there is non-zero y range if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) { - stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1)) + if (!(all(draw_quantiles >= 0) && all(draw_quantiles <= 1))) { + abort("`draw_quantiles must be between 0 and 1") + } # Compute the quantile segments and combine with existing aesthetics quantiles <- create_quantile_segment_frame(data, draw_quantiles) diff --git a/R/ggproto.r b/R/ggproto.r index 9e2180f684..c0467e4b21 100644 --- a/R/ggproto.r +++ b/R/ggproto.r @@ -59,7 +59,7 @@ ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) { members <- list(...) if (length(members) != sum(nzchar(names(members)))) { - stop("All members of a ggproto object must be named.") + abort("All members of a ggproto object must be named.") } # R <3.1.2 will error when list2env() is given an empty list, so we need to @@ -79,7 +79,7 @@ ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) { super <- find_super() if (!is.null(super)) { if (!is.ggproto(super)) { - stop("`_inherit` must be a ggproto object.") + abort("`_inherit` must be a ggproto object.") } e$super <- find_super class(e) <- c(`_class`, class(super)) @@ -119,11 +119,10 @@ fetch_ggproto <- function(x, name) { } else if (is.function(super)) { res <- fetch_ggproto(super(), name) } else { - stop( + abort(paste0( class(x)[[1]], " was built with an incompatible version of ggproto.\n", - "Please reinstall the package that provides this extension.", - call. = FALSE - ) + "Please reinstall the package that provides this extension." + )) } } diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index 4250443b9d..ffe3f6abe8 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -282,13 +282,13 @@ guide_gengrob.colorbar <- function(guide, theme) { # settings of location and size if (guide$direction == "horizontal") { label.position <- guide$label.position %||% "bottom" - if (!label.position %in% c("top", "bottom")) stop("label position \"", label.position, "\" is invalid") + if (!label.position %in% c("top", "bottom")) abort(paste0("label position \"", label.position, "\" is invalid")) barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5)) barheight <- height_cm(guide$barheight %||% theme$legend.key.height) } else { # guide$direction == "vertical" label.position <- guide$label.position %||% "right" - if (!label.position %in% c("left", "right")) stop("label position \"", label.position, "\" is invalid") + if (!label.position %in% c("left", "right")) abort(paste0("label position \"", label.position, "\" is invalid")) barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width) barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5)) diff --git a/R/guide-legend.r b/R/guide-legend.r index 3558d38b1f..67c00dea85 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -307,7 +307,7 @@ guide_gengrob.legend <- function(guide, theme) { # default setting label.position <- guide$label.position %||% "right" if (!label.position %in% c("top", "bottom", "left", "right")) - stop("label position \"", label.position, "\" is invalid") + abort(paste0("label position \"", label.position, "\" is invalid")) nbreak <- nrow(guide$key) @@ -398,10 +398,7 @@ guide_gengrob.legend <- function(guide, theme) { if (!is.null(guide$nrow) && !is.null(guide$ncol) && guide$nrow * guide$ncol < nbreak) { - stop( - "`nrow` * `ncol` needs to be larger than the number of breaks", - call. = FALSE - ) + abort("`nrow` * `ncol` needs to be larger than the number of breaks") } # If neither nrow/ncol specified, guess with "reasonable" values diff --git a/R/guides-.r b/R/guides-.r index 0ad41eb131..c6fb06d57c 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -156,7 +156,7 @@ validate_guide <- function(guide) { else if (inherits(guide, "guide")) guide else - stop("Unknown guide: ", guide) + abort(paste0("Unknown guide: ", guide)) } # train each scale in scales and generate the definition of guide @@ -183,7 +183,7 @@ guides_train <- function(scales, theme, guides, labels) { # check the consistency of the guide and scale. if (!identical(guide$available_aes, "any") && !any(scale$aesthetics %in% guide$available_aes)) - stop("Guide '", guide$name, "' cannot be used for '", scale$aesthetics, "'.") + abort(paste0("Guide '", guide$name, "' cannot be used for '", scale$aesthetics, "'.")) guide$title <- scale$make_title(guide$title %|W|% scale$name %|W|% labels[[output]]) @@ -227,7 +227,7 @@ guides_gengrob <- function(gdefs, theme) { function(g) { g$title.position <- g$title.position %||% switch(g$direction, vertical = "top", horizontal = "left") if (!g$title.position %in% c("top", "bottom", "left", "right")) - stop("title position \"", g$title.position, "\" is invalid") + abort(paste0("title position \"", g$title.position, "\" is invalid")) g }) diff --git a/R/guides-axis.r b/R/guides-axis.r index d7bc5449ed..c206f0bfb9 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -225,7 +225,7 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { # it is not worth the effort to align upside-down labels properly if (angle > 90 || angle < -90) { - stop("`angle` must be between 90 and -90", call. = FALSE) + abort("`angle` must be between 90 and -90") } if (axis_position == "bottom") { @@ -253,6 +253,6 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { vjust = if (angle > 0) 1 else if (angle < 0) 0 else 0.5, ) } else { - stop("Unrecognized position: '", axis_position, "'", call. = FALSE) + abort(paste0("Unrecognized position: '", axis_position, "'")) } } diff --git a/R/labeller.r b/R/labeller.r index ef5565437e..2cecc6a0fc 100644 --- a/R/labeller.r +++ b/R/labeller.r @@ -248,12 +248,12 @@ is_labeller <- function(x) inherits(x, "labeller") resolve_labeller <- function(rows, cols, labels) { if (is.null(cols) && is.null(rows)) { - stop("Supply one of rows or cols", call. = FALSE) + abort("Supply one of rows or cols") } if (attr(labels, "facet") == "wrap") { # Return either rows or cols for facet_wrap() if (!is.null(cols) && !is.null(rows)) { - stop("Cannot supply both rows and cols to facet_wrap()", call. = FALSE) + abort("Cannot supply both rows and cols to facet_wrap()") } cols %||% rows } else { @@ -446,8 +446,8 @@ labeller <- function(..., .rows = NULL, .cols = NULL, # Check that variable-specific labellers do not overlap with # margin-wide labeller if (any(names(dots) %in% names(labels))) { - stop("Conflict between .", attr(labels, "type"), " and ", - paste(names(dots), collapse = ", "), call. = FALSE) + abort(paste0("Conflict between .", attr(labels, "type"), " and ", + paste(names(dots), collapse = ", "))) } } diff --git a/R/layer.r b/R/layer.r index e2f60a13e5..934d1216b2 100644 --- a/R/layer.r +++ b/R/layer.r @@ -68,11 +68,11 @@ layer <- function(geom = NULL, stat = NULL, inherit.aes = TRUE, check.aes = TRUE, check.param = TRUE, show.legend = NA, key_glyph = NULL, layer_class = Layer) { if (is.null(geom)) - stop("Attempted to create layer with no geom.", call. = FALSE) + abort("Attempted to create layer with no geom.") if (is.null(stat)) - stop("Attempted to create layer with no stat.", call. = FALSE) + abort("Attempted to create layer with no stat.") if (is.null(position)) - stop("Attempted to create layer with no position.", call. = FALSE) + abort("Attempted to create layer with no position.") # Handle show_guide/show.legend if (!is.null(params$show_guide)) { @@ -169,7 +169,7 @@ validate_mapping <- function(mapping) { ) } - stop(msg, call. = FALSE) + abort(msg) } # For backward compatibility with pre-tidy-eval layers @@ -204,7 +204,7 @@ Layer <- ggproto("Layer", NULL, } else if (is.function(self$data)) { data <- self$data(plot_data) if (!is.data.frame(data)) { - stop("Data function must return a data.frame", call. = FALSE) + abort("Data function must return a data.frame") } data } else { @@ -253,7 +253,7 @@ Layer <- ggproto("Layer", NULL, paste0(vapply(nondata_cols, function(x) {paste0(x, " = ", as_label(aesthetics[[x]]))}, character(1)), collapse = ", "), ". \nDid you mistype the name of a data column or forget to add stat()?" ) - stop(msg, call. = FALSE) + abort(msg) } n <- nrow(data) @@ -316,7 +316,7 @@ Layer <- ggproto("Layer", NULL, paste0(vapply(nondata_stat_cols, function(x) {paste0(x, " = ", as_label(aesthetics[[x]]))}, character(1)), collapse = ", "), ". \nDid you map your stat in the wrong layer?" ) - stop(msg, call. = FALSE) + abort(msg) } names(stat_data) <- names(new) @@ -389,16 +389,15 @@ check_subclass <- function(x, subclass, obj <- find_global(name, env = env) if (is.null(obj) || !inherits(obj, subclass)) { - stop("Can't find `", argname, "` called \"", x, "\"", call. = FALSE) + abort(paste0("Can't find `", argname, "` called \"", x, "\"")) } else { obj } } else { - stop( + abort(paste0( "`", argname, "` must be either a string or a ", subclass, " object, ", - "not ", obj_desc(x), - call. = FALSE - ) + "not ", obj_desc(x) + )) } } diff --git a/R/layout.R b/R/layout.R index 966f301fda..3f0de90d7b 100644 --- a/R/layout.R +++ b/R/layout.R @@ -270,7 +270,7 @@ scale_apply <- function(data, vars, method, scale_id, scales) { if (length(vars) == 0) return() if (nrow(data) == 0) return() - if (any(is.na(scale_id))) stop() + if (any(is.na(scale_id))) abort("`scale_id`` must not be `NA`") scale_index <- unname(split( seq_along(scale_id), diff --git a/R/limits.r b/R/limits.r index 7d989b4e42..55d62bf1b0 100644 --- a/R/limits.r +++ b/R/limits.r @@ -76,7 +76,7 @@ lims <- function(...) { args <- list(...) if (any(!has_name(args))) { - stop("All arguments must be named", call. = FALSE) + abort("All arguments must be named") } Map(limits, args, names(args)) @@ -108,7 +108,7 @@ ylim <- function(...) { limits <- function(lims, var) UseMethod("limits") #' @export limits.numeric <- function(lims, var) { - stopifnot(length(lims) == 2) + if (length(lims) != 2) abort("lims must be a two-element vector") if (!any(is.na(lims)) && lims[1] > lims[2]) { trans <- "reverse" } else { @@ -133,17 +133,17 @@ limits.factor <- function(lims, var) { } #' @export limits.Date <- function(lims, var) { - stopifnot(length(lims) == 2) + if (length(lims) != 2) abort("lims must be a two-element vector") make_scale("date", var, limits = lims) } #' @export limits.POSIXct <- function(lims, var) { - stopifnot(length(lims) == 2) + if (length(lims) != 2) abort("lims must be a two-element vector") make_scale("datetime", var, limits = lims) } #' @export limits.POSIXlt <- function(lims, var) { - stopifnot(length(lims) == 2) + if (length(lims) != 2) abort("lims must be a two-element vector") make_scale("datetime", var, limits = as.POSIXct(lims)) } diff --git a/R/margins.R b/R/margins.R index e3382a1601..4d05457eef 100644 --- a/R/margins.R +++ b/R/margins.R @@ -240,7 +240,7 @@ justify_grobs <- function(grobs, x = NULL, y = NULL, hjust = 0.5, vjust = 0.5, return(lapply(grobs, justify_grobs, x, y, hjust, vjust, int_angle, debug)) } else { - stop("need individual grob or list of grobs as argument.") + abort("need individual grob or list of grobs as argument.") } } diff --git a/R/performance.R b/R/performance.R index 4f51f0d1f6..9c96ede298 100644 --- a/R/performance.R +++ b/R/performance.R @@ -1,14 +1,14 @@ # Fast data.frame constructor and indexing # No checking, recycling etc. unless asked for new_data_frame <- function(x = list(), n = NULL) { - if (length(x) != 0 && is.null(names(x))) stop("Elements must be named", call. = FALSE) + if (length(x) != 0 && is.null(names(x))) abort("Elements must be named") lengths <- vapply(x, length, integer(1)) if (is.null(n)) { n <- if (length(x) == 0 || min(lengths) == 0) 0 else max(lengths) } for (i in seq_along(x)) { if (lengths[i] == n) next - if (lengths[i] != 1) stop("Elements must equal the number of rows or 1", call. = FALSE) + if (lengths[i] != 1) abort("Elements must equal the number of rows or 1") x[[i]] <- rep(x[[i]], n) } @@ -23,7 +23,7 @@ data_frame <- function(...) { } data.frame <- function(...) { - stop('Please use `data_frame()` or `new_data_frame()` instead of `data.frame()` for better performance. See the vignette "ggplot2 internal programming guidelines" for details.', call. = FALSE) + abort('Please use `data_frame()` or `new_data_frame()` instead of `data.frame()` for better performance. See the vignette "ggplot2 internal programming guidelines" for details.') } split_matrix <- function(x, col_names = colnames(x)) { @@ -49,5 +49,5 @@ modify_list <- function(old, new) { old } modifyList <- function(...) { - stop('Please use `modify_list()` instead of `modifyList()` for better performance. See the vignette "ggplot2 internal programming guidelines" for details.', call. = FALSE) + abort('Please use `modify_list()` instead of `modifyList()` for better performance. See the vignette "ggplot2 internal programming guidelines" for details.') } diff --git a/R/plot-build.r b/R/plot-build.r index e24a3d8882..b8a68c9ac8 100644 --- a/R/plot-build.r +++ b/R/plot-build.r @@ -267,11 +267,11 @@ ggplot_gtable.ggplot_built <- function(data) { # "plot" means align to the entire plot (except margins and tag) title_pos <- theme$plot.title.position %||% "panel" if (!(title_pos %in% c("panel", "plot"))) { - stop('plot.title.position should be either "panel" or "plot".', call. = FALSE) + abort('plot.title.position should be either "panel" or "plot".') } caption_pos <- theme$plot.caption.position %||% "panel" if (!(caption_pos %in% c("panel", "plot"))) { - stop('plot.caption.position should be either "panel" or "plot".', call. = FALSE) + abort('plot.caption.position should be either "panel" or "plot".') } pans <- plot_table$layout[grepl("^panel", plot_table$layout$name), , drop = FALSE] @@ -313,8 +313,8 @@ ggplot_gtable.ggplot_built <- function(data) { "bottom", "bottomright") if (!(tag_pos == "manual" || tag_pos %in% valid_pos)) { - stop("plot.tag.position should be a coordinate or one of ", - paste(valid_pos, collapse = ', '), call. = FALSE) + abort(paste0("plot.tag.position should be a coordinate or one of ", + paste(valid_pos, collapse = ', '))) } if (tag_pos == "manual") { diff --git a/R/plot-construction.r b/R/plot-construction.r index 4f49d9d16b..a7ea5e522a 100644 --- a/R/plot-construction.r +++ b/R/plot-construction.r @@ -39,9 +39,7 @@ #' base + list(subset(mpg, fl == "p"), geom_smooth()) "+.gg" <- function(e1, e2) { if (missing(e2)) { - stop("Cannot use `+.gg()` with a single argument. ", - "Did you accidentally put + on a new line?", - call. = FALSE) + abort("Cannot use `+.gg()` with a single argument. Did you accidentally put + on a new line?") } # Get the name of what was passed in as e2, and pass along so that it @@ -51,9 +49,7 @@ if (is.theme(e1)) add_theme(e1, e2, e2name) else if (is.ggplot(e1)) add_ggplot(e1, e2, e2name) else if (is.ggproto(e1)) { - stop("Cannot add ggproto objects together.", - " Did you forget to add this object to a ggplot object?", - call. = FALSE) + abort("Cannot add ggproto objects together. Did you forget to add this object to a ggplot object?") } } @@ -88,7 +84,7 @@ ggplot_add <- function(object, plot, object_name) { } #' @export ggplot_add.default <- function(object, plot, object_name) { - stop("Don't know how to add ", object_name, " to a plot", call. = FALSE) + abort(paste0("Don't know how to add ", object_name, " to a plot")) } #' @export ggplot_add.NULL <- function(object, plot, object_name) { diff --git a/R/plot.r b/R/plot.r index fc7cfe1bc8..77b8191102 100644 --- a/R/plot.r +++ b/R/plot.r @@ -80,7 +80,7 @@ ggplot <- function(data = NULL, mapping = aes(), ..., ggplot.default <- function(data = NULL, mapping = aes(), ..., environment = parent.frame()) { if (!missing(mapping) && !inherits(mapping, "uneval")) { - stop("Mapping should be created with `aes() or `aes_()`.", call. = FALSE) + abort("Mapping should be created with `aes() or `aes_()`.") } data <- fortify(data, ...) @@ -106,7 +106,7 @@ ggplot.default <- function(data = NULL, mapping = aes(), ..., ggplot.function <- function(data = NULL, mapping = aes(), ..., environment = parent.frame()) { # Added to avoid functions end in ggplot.default - stop("You're passing a function as global data.\nHave you misspelled the `data` argument in `ggplot()`", call. = FALSE) + abort("You're passing a function as global data.\nHave you misspelled the `data` argument in `ggplot()`") } plot_clone <- function(plot) { diff --git a/R/position-.r b/R/position-.r index 1df4d2c9e7..1b4224d3ca 100644 --- a/R/position-.r +++ b/R/position-.r @@ -63,7 +63,7 @@ Position <- ggproto("Position", }, compute_panel = function(self, data, params, scales) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") } ) diff --git a/R/position-collide.r b/R/position-collide.r index cc4aa0e2df..e741480970 100644 --- a/R/position-collide.r +++ b/R/position-collide.r @@ -62,7 +62,7 @@ collide <- function(data, width = NULL, name, strategy, data$y <- data$ymax data } else { - stop("Neither y nor ymax defined") + abort("Neither y nor ymax defined") } } diff --git a/R/position-jitterdodge.R b/R/position-jitterdodge.R index 494db5f9f8..7b893bbaa8 100644 --- a/R/position-jitterdodge.R +++ b/R/position-jitterdodge.R @@ -47,7 +47,7 @@ PositionJitterdodge <- ggproto("PositionJitterdodge", Position, # Adjust the x transformation based on the number of 'dodge' variables dodgecols <- intersect(c("fill", "colour", "linetype", "shape", "size", "alpha"), colnames(data)) if (length(dodgecols) == 0) { - stop("`position_jitterdodge()` requires at least one aesthetic to dodge by", call. = FALSE) + abort("`position_jitterdodge()` requires at least one aesthetic to dodge by") } ndodge <- lapply(data[dodgecols], levels) # returns NULL for numeric, i.e. non-dodge layers ndodge <- length(unique(unlist(ndodge))) diff --git a/R/quick-plot.r b/R/quick-plot.r index 81188e9474..4efa3b904d 100644 --- a/R/quick-plot.r +++ b/R/quick-plot.r @@ -69,7 +69,7 @@ qplot <- function(x, y, ..., data, facets = NULL, margins = FALSE, if (!missing(stat)) warning("`stat` is deprecated", call. = FALSE) if (!missing(position)) warning("`position` is deprecated", call. = FALSE) - if (!is.character(geom)) stop("`geom` must be a character vector", call. = FALSE) + if (!is.character(geom)) abort("`geom` must be a character vector") exprs <- enquos(x = x, y = y, ...) is_missing <- vapply(exprs, quo_is_missing, logical(1)) diff --git a/R/save.r b/R/save.r index 965d9c115e..64db31c58d 100644 --- a/R/save.r +++ b/R/save.r @@ -89,12 +89,12 @@ parse_dpi <- function(dpi) { screen = 72, print = 300, retina = 320, - stop("Unknown DPI string", call. = FALSE) + abort("Unknown DPI string") ) } else if (is.numeric(dpi) && length(dpi) == 1) { dpi } else { - stop("DPI must be a single number or string", call. = FALSE) + abort("DPI must be a single number or string") } } @@ -120,9 +120,9 @@ plot_dim <- function(dim = c(NA, NA), scale = 1, units = c("in", "cm", "mm"), } if (limitsize && any(dim >= 50)) { - stop("Dimensions exceed 50 inches (height and width are specified in '", + abort(paste0("Dimensions exceed 50 inches (height and width are specified in '", units, "' not pixels). If you're sure you want a plot that big, use ", - "`limitsize = FALSE`.", call. = FALSE) + "`limitsize = FALSE`.")) } dim @@ -159,12 +159,12 @@ plot_dev <- function(device, filename = NULL, dpi = 300) { } if (!is.character(device) || length(device) != 1) { - stop("`device` must be NULL, a string or a function.", call. = FALSE) + abort("`device` must be NULL, a string or a function.") } dev <- devices[[device]] if (is.null(dev)) { - stop("Unknown graphics device '", device, "'", call. = FALSE) + abort(paste0("Unknown graphics device '", device, "'")) } dev } diff --git a/R/scale-.r b/R/scale-.r index 9ccd77b42d..16e2251d14 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -288,7 +288,7 @@ Scale <- ggproto("Scale", NULL, aesthetics = aes(), scale_name = NULL, palette = function() { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, range = ggproto(NULL, Range), @@ -304,7 +304,7 @@ Scale <- ggproto("Scale", NULL, is_discrete = function() { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, train_df = function(self, df) { @@ -318,7 +318,7 @@ Scale <- ggproto("Scale", NULL, }, train = function(self, x) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, reset = function(self) { @@ -343,7 +343,7 @@ Scale <- ggproto("Scale", NULL, }, transform = function(self, x) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, map_df = function(self, df, i = NULL) { @@ -365,11 +365,11 @@ Scale <- ggproto("Scale", NULL, }, map = function(self, x, limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, rescale = function(self, x, limits = self$get_limits(), range = self$dimension()) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, get_limits = function(self) { @@ -388,11 +388,11 @@ Scale <- ggproto("Scale", NULL, }, dimension = function(self, expand = expansion(0, 0), limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, get_breaks = function(self, limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, break_positions = function(self, range = self$get_limits()) { @@ -400,19 +400,19 @@ Scale <- ggproto("Scale", NULL, }, get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, get_labels = function(self, breaks = self$get_breaks()) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, clone = function(self) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, break_info = function(self, range = NULL) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, axis_order = function(self) { @@ -443,7 +443,7 @@ check_breaks_labels <- function(breaks, labels) { bad_labels <- is.atomic(breaks) && is.atomic(labels) && length(breaks) != length(labels) if (bad_labels) { - stop("`breaks` and `labels` must have the same length", call. = FALSE) + abort("`breaks` and `labels` must have the same length") } TRUE @@ -511,7 +511,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (identical(self$breaks, NA)) { - stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) + abort("Invalid breaks specification. Use NULL, not NA") } if (zero_range(as.numeric(limits))) { @@ -542,7 +542,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (identical(self$minor_breaks, NA)) { - stop("Invalid minor_breaks specification. Use NULL, not NA", call. = FALSE) + abort("Invalid minor_breaks specification. Use NULL, not NA") } if (is.waive(self$minor_breaks)) { @@ -575,7 +575,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (identical(self$labels, NA)) { - stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) + abort("Invalid labels specification. Use NULL, not NA") } if (is.waive(self$labels)) { @@ -587,7 +587,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (length(labels) != length(breaks)) { - stop("Breaks and labels are different lengths", call. = FALSE) + abort("Breaks and labels are different lengths") } labels @@ -709,7 +709,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } if (identical(self$breaks, NA)) { - stop("Invalid breaks specification. Use NULL, not NA", call. = FALSE) + abort("Invalid breaks specification. Use NULL, not NA") } if (is.waive(self$breaks)) { @@ -741,7 +741,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } if (identical(self$labels, NA)) { - stop("Invalid labels specification. Use NULL, not NA", call. = FALSE) + abort("Invalid labels specification. Use NULL, not NA") } if (is.waive(self$labels)) { diff --git a/R/scale-colour.r b/R/scale-colour.r index d50fb9e22c..fb2c29a74c 100644 --- a/R/scale-colour.r +++ b/R/scale-colour.r @@ -43,7 +43,7 @@ scale_colour_continuous <- function(..., type, gradient = scale_colour_gradient(...), viridis = scale_colour_viridis_c(...), - stop("Unknown scale type", call. = FALSE) + abort("Unknown scale type") ) } @@ -55,6 +55,6 @@ scale_fill_continuous <- function(..., type, gradient = scale_fill_gradient(...), viridis = scale_fill_viridis_c(...), - stop("Unknown scale type", call. = FALSE) + abort("Unknown scale type") ) } diff --git a/R/scale-expansion.r b/R/scale-expansion.r index ee0e6952b4..d733460046 100644 --- a/R/scale-expansion.r +++ b/R/scale-expansion.r @@ -36,10 +36,9 @@ #' scale_y_continuous(expand = expansion(mult = .05)) #' expansion <- function(mult = 0, add = 0) { - stopifnot( - is.numeric(mult), (length(mult) %in% 1:2), - is.numeric(add), (length(add) %in% 1:2) - ) + if (!(is.numeric(mult) && (length(mult) %in% 1:2) && is.numeric(add) && (length(add) %in% 1:2))) { + abort("`mult` and `add` must be numeric vectors with 1 or 2 elements") + } mult <- rep(mult, length.out = 2) add <- rep(add, length.out = 2) @@ -66,10 +65,9 @@ expand_scale <- function(mult = 0, add = 0) { #' @noRd #' expand_range4 <- function(limits, expand) { - stopifnot( - is.numeric(expand), - length(expand) %in% c(2,4) - ) + if (!(is.numeric(expand) && length(expand) %in% c(2,4))) { + abort("`expand` must be a numeric vector with 1 or 2 elements") + } if (all(!is.finite(limits))) { return(c(-Inf, Inf)) diff --git a/R/scale-linetype.r b/R/scale-linetype.r index 874c25d6ff..15feefdb12 100644 --- a/R/scale-linetype.r +++ b/R/scale-linetype.r @@ -36,7 +36,7 @@ scale_linetype <- function(..., na.value = "blank") { #' @rdname scale_linetype #' @export scale_linetype_continuous <- function(...) { - stop("A continuous variable can not be mapped to linetype", call. = FALSE) + abort("A continuous variable can not be mapped to linetype") } #' @rdname scale_linetype #' @export diff --git a/R/scale-manual.r b/R/scale-manual.r index fc8a28f001..0079755fac 100644 --- a/R/scale-manual.r +++ b/R/scale-manual.r @@ -126,8 +126,8 @@ manual_scale <- function(aesthetic, values = NULL, ...) { pal <- function(n) { if (n > length(values)) { - stop("Insufficient values in manual scale. ", n, " needed but only ", - length(values), " provided.", call. = FALSE) + abort(paste0("Insufficient values in manual scale. ", n, " needed but only ", + length(values), " provided.")) } values } diff --git a/R/scale-shape.r b/R/scale-shape.r index 2a7c8cabac..47dd7d9ebb 100644 --- a/R/scale-shape.r +++ b/R/scale-shape.r @@ -55,5 +55,5 @@ scale_shape_ordinal <- function(...) { #' @export #' @usage NULL scale_shape_continuous <- function(...) { - stop("A continuous variable can not be mapped to shape", call. = FALSE) + abort("A continuous variable can not be mapped to shape") } diff --git a/R/scale-view.r b/R/scale-view.r index 13afdba516..840c7feb15 100644 --- a/R/scale-view.r +++ b/R/scale-view.r @@ -75,8 +75,8 @@ view_scale_empty <- function() { get_breaks = function() NULL, get_breaks_minor = function() NULL, get_labels = function() NULL, - rescale = function(x) stop("Not implemented", call. = FALSE), - map = function(x) stop("Not implemented", call. = FALSE), + rescale = function(x) abort("Not implemented"), + map = function(x) abort("Not implemented"), make_title = function(title) title, break_positions = function() NULL, break_positions_minor = function() NULL diff --git a/R/stat-.r b/R/stat-.r index f1b1b77985..5ee8ce2056 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -118,7 +118,7 @@ Stat <- ggproto("Stat", }, compute_group = function(self, data, scales) { - stop("Not implemented", call. = FALSE) + abort("Not implemented") }, finish_layer = function(self, data, params) { diff --git a/R/stat-bin.r b/R/stat-bin.r index 591034bbfb..0cef308727 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -83,11 +83,10 @@ stat_bin <- function(mapping = NULL, data = NULL, StatBin <- ggproto("StatBin", Stat, setup_params = function(data, params) { if (!is.null(data$y) || !is.null(params$y)) { - stop("stat_bin() must not be used with a y aesthetic.", call. = FALSE) + abort("stat_bin() must not be used with a y aesthetic.") } if (is.integer(data$x)) { - stop('StatBin requires a continuous x variable: the x variable is discrete. Perhaps you want stat="count"?', - call. = FALSE) + abort('StatBin requires a continuous x variable: the x variable is discrete. Perhaps you want stat="count"?') } if (!is.null(params$drop)) { @@ -105,10 +104,10 @@ StatBin <- ggproto("StatBin", Stat, params$right <- NULL } if (!is.null(params$width)) { - stop("`width` is deprecated. Do you want `geom_bar()`?", call. = FALSE) + abort("`width` is deprecated. Do you want `geom_bar()`?") } if (!is.null(params$boundary) && !is.null(params$center)) { - stop("Only one of `boundary` and `center` may be specified.", call. = FALSE) + abort("Only one of `boundary` and `center` may be specified.") } if (is.null(params$breaks) && is.null(params$binwidth) && is.null(params$bins)) { diff --git a/R/stat-bin2d.r b/R/stat-bin2d.r index 8ace8f25e5..6358372ff9 100644 --- a/R/stat-bin2d.r +++ b/R/stat-bin2d.r @@ -124,12 +124,12 @@ bin2d_breaks <- function(scale, breaks = NULL, origin = NULL, binwidth = NULL, if (is.null(binwidth) || identical(binwidth, NA)) { binwidth <- diff(range) / bins } - stopifnot(is.numeric(binwidth), length(binwidth) == 1) + if (!(is.numeric(binwidth) && length(binwidth) == 1)) abort("`binwidth` must be a numeric scalar") if (is.null(origin) || identical(origin, NA)) { origin <- round_any(range[1], binwidth, floor) } - stopifnot(is.numeric(origin), length(origin) == 1) + if (!(is.numeric(origin) && length(origin) == 1)) abort("`origin` must be a numeric scalar") breaks <- seq(origin, range[2] + binwidth, binwidth) adjust_breaks(breaks, right) diff --git a/R/stat-bindot.r b/R/stat-bindot.r index 2df8433101..a70cc2c988 100644 --- a/R/stat-bindot.r +++ b/R/stat-bindot.r @@ -73,7 +73,7 @@ StatBindot <- ggproto("StatBindot", Stat, # Check that weights are whole numbers (for dots, weights must be whole) if (!is.null(data$weight) && any(!is.wholenumber(data$weight)) && any(data$weight < 0)) { - stop("Weights for stat_bindot must be nonnegative integers.") + abort("Weights for stat_bindot must be nonnegative integers.") } if (binaxis == "x") { diff --git a/R/stat-count.r b/R/stat-count.r index c08381d8c7..28be82925d 100644 --- a/R/stat-count.r +++ b/R/stat-count.r @@ -25,7 +25,7 @@ stat_count <- function(mapping = NULL, data = NULL, ... ) if (!is.null(params$y)) { - stop("stat_count() must not be used with a y aesthetic.", call. = FALSE) + abort("stat_count() must not be used with a y aesthetic.") } layer( @@ -51,7 +51,7 @@ StatCount <- ggproto("StatCount", Stat, setup_params = function(data, params) { if (!is.null(data$y)) { - stop("stat_count() must not be used with a y aesthetic.", call. = FALSE) + abort("stat_count() must not be used with a y aesthetic.") } params }, diff --git a/R/stat-qq-line.R b/R/stat-qq-line.R index b577fb96eb..3ff53d6df6 100644 --- a/R/stat-qq-line.R +++ b/R/stat-qq-line.R @@ -64,7 +64,7 @@ StatQqLine <- ggproto("StatQqLine", Stat, if (is.null(quantiles)) { quantiles <- stats::ppoints(n) } else { - stopifnot(length(quantiles) == n) + if (length(quantiles) != n) abort("`quantiles` must have the same length as the data") } theoretical <- do.call( @@ -73,10 +73,9 @@ StatQqLine <- ggproto("StatQqLine", Stat, ) if (length(line.p) != 2) { - stop( + abort(paste0( "Cannot fit line quantiles ", line.p, - ". Parameter line.p must have length 2.", - call. = FALSE) + ". Parameter line.p must have length 2.")) } x_coords <- do.call(distribution, c(list(p = line.p), dparams)) diff --git a/R/stat-qq.r b/R/stat-qq.r index ef30ba550f..6842f919ac 100644 --- a/R/stat-qq.r +++ b/R/stat-qq.r @@ -93,8 +93,8 @@ StatQq <- ggproto("StatQq", Stat, # Compute theoretical quantiles if (is.null(quantiles)) { quantiles <- stats::ppoints(n) - } else { - stopifnot(length(quantiles) == n) + } else if (length(quantiles) != n) { + abort("length of quantiles must match length of data") } theoretical <- do.call(distribution, c(list(p = quote(quantiles)), dparams)) diff --git a/R/stat-summary.r b/R/stat-summary.r index 27ed095e3f..1de6d7a45d 100644 --- a/R/stat-summary.r +++ b/R/stat-summary.r @@ -196,7 +196,7 @@ wrap_hmisc <- function(fun) { function(x, ...) { if (!requireNamespace("Hmisc", quietly = TRUE)) - stop("Hmisc package required for this function", call. = FALSE) + abort("Hmisc package required for this function") fun <- getExportedValue("Hmisc", fun) result <- do.call(fun, list(x = quote(x), ...)) diff --git a/R/stat-ydensity.r b/R/stat-ydensity.r index 978f60ad0c..5e0880e5d2 100644 --- a/R/stat-ydensity.r +++ b/R/stat-ydensity.r @@ -108,7 +108,7 @@ StatYdensity <- ggproto("StatYdensity", Stat, calc_bw <- function(x, bw) { if (is.character(bw)) { if (length(x) < 2) - stop("need at least 2 points to select a bandwidth automatically", call. = FALSE) + abort("need at least 2 points to select a bandwidth automatically") bw <- switch( to_lower_ascii(bw), nrd0 = stats::bw.nrd0(x), @@ -118,7 +118,7 @@ calc_bw <- function(x, bw) { sj = , `sj-ste` = stats::bw.SJ(x, method = "ste"), `sj-dpi` = stats::bw.SJ(x, method = "dpi"), - stop("unknown bandwidth rule") + abort("unknown bandwidth rule") ) } bw diff --git a/R/summarise-plot.R b/R/summarise-plot.R index 6083089ac5..edbbaf9711 100644 --- a/R/summarise-plot.R +++ b/R/summarise-plot.R @@ -59,7 +59,7 @@ NULL #' @rdname summarise_plot #' @export summarise_layout = function(p) { - stopifnot(inherits(p, "ggplot_built")) + if (!inherits(p, "ggplot_built")) abort("`p` must be a ggplot_build object") l <- p$layout layout <- l$layout @@ -96,7 +96,7 @@ summarise_layout = function(p) { #' @rdname summarise_plot #' @export summarise_coord = function(p) { - stopifnot(inherits(p, "ggplot_built")) + if (!inherits(p, "ggplot_built")) abort("`p` must be a ggplot_build object") # Given a transform object, find the log base; if the transform object is # NULL, or if it's not a log transform, return NA. @@ -119,7 +119,7 @@ summarise_coord = function(p) { #' @rdname summarise_plot #' @export summarise_layers <- function(p) { - stopifnot(inherits(p, "ggplot_built")) + if (!inherits(p, "ggplot_built")) abort("`p` must be a ggplot_build object") # Default mappings. Make sure it's a regular list instead of an uneval # object. diff --git a/R/theme-current.R b/R/theme-current.R index ac860f9371..47d306a702 100644 --- a/R/theme-current.R +++ b/R/theme-current.R @@ -99,7 +99,7 @@ theme_replace <- function(...) { #' @export "%+replace%" <- function(e1, e2) { if (!is.theme(e1) || !is.theme(e2)) { - stop("%+replace% requires two theme objects", call. = FALSE) + abort("%+replace% requires two theme objects") } # Can't use modifyList here since it works recursively and drops NULLs diff --git a/R/theme-elements.r b/R/theme-elements.r index f2916d71e8..ee84543fba 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -397,7 +397,7 @@ validate_element <- function(el, elname) { eldef <- ggplot_global$element_tree[[elname]] if (is.null(eldef)) { - stop('"', elname, '" is not a valid theme element name.') + abort(paste0('"', elname, '" is not a valid theme element name.')) } # NULL values for elements are OK @@ -407,12 +407,12 @@ validate_element <- function(el, elname) { # Need to be a bit looser here since sometimes it's a string like "top" # but sometimes its a vector like c(0,0) if (!is.character(el) && !is.numeric(el)) - stop("Element ", elname, " must be a string or numeric vector.") + abort(paste0("Element ", elname, " must be a string or numeric vector.")) } else if (eldef$class == "margin") { if (!is.unit(el) && length(el) == 4) - stop("Element ", elname, " must be a unit vector of length 4.") + abort(paste0("Element ", elname, " must be a unit vector of length 4.")) } else if (!inherits(el, eldef$class) && !inherits(el, "element_blank")) { - stop("Element ", elname, " must be a ", eldef$class, " object.") + abort(paste0("Element ", elname, " must be a ", eldef$class, " object.")) } invisible() } diff --git a/R/theme.r b/R/theme.r index fe461f2bf5..9ff5e01391 100644 --- a/R/theme.r +++ b/R/theme.r @@ -436,8 +436,7 @@ plot_theme <- function(x, default = theme_get()) { #' @keywords internal add_theme <- function(t1, t2, t2name) { if (!is.theme(t2)) { - stop("Don't know how to add RHS to a theme object", - call. = FALSE) + abort("Don't know how to add RHS to a theme object") } # Iterate over the elements that are to be updated @@ -549,7 +548,7 @@ calc_element <- function(element, theme, verbose = FALSE) { # it is of the class specified in .element_tree if (!is.null(theme[[element]]) && !inherits(theme[[element]], ggplot_global$element_tree[[element]]$class)) { - stop(element, " should have class ", ggplot_global$element_tree[[element]]$class) + abort(paste0(element, " should have class ", ggplot_global$element_tree[[element]]$class)) } # Get the names of parents from the inheritance tree @@ -560,8 +559,8 @@ calc_element <- function(element, theme, verbose = FALSE) { # Check that all the properties of this element are non-NULL nullprops <- vapply(theme[[element]], is.null, logical(1)) if (any(nullprops)) { - stop("Theme element '", element, "' has NULL property: ", - paste(names(nullprops)[nullprops], collapse = ", ")) + abort(paste0("Theme element '", element, "' has NULL property: ", + paste(names(nullprops)[nullprops], collapse = ", "))) } if (verbose) message("nothing (top level)") @@ -600,13 +599,13 @@ merge_element <- function(new, old) { #' @rdname merge_element #' @export merge_element.default <- function(new, old) { - stop("No method for merging ", class(new)[1], " into ", class(old)[1], call. = FALSE) + abort(paste0("No method for merging ", class(new)[1], " into ", class(old)[1])) } #' @rdname merge_element #' @export merge_element.element <- function(new, old) { if (!inherits(new, class(old)[1])) { - stop("Only elements of the same class can be merged", call. = FALSE) + abort("Only elements of the same class can be merged") } # Override NULL properties of new with the values in old # Get logical vector of NULL properties in new diff --git a/R/utilities-break.r b/R/utilities-break.r index b6606e1c95..daf03e5e9c 100644 --- a/R/utilities-break.r +++ b/R/utilities-break.r @@ -30,7 +30,7 @@ cut_interval <- function(x, n = NULL, length = NULL, ...) { cut_number <- function(x, n = NULL, ...) { brk <- breaks(x, "n", n) if (anyDuplicated(brk)) - stop("Insufficient data values to produce ", n, " bins.", call. = FALSE) + abort(paste0("Insufficient data values to produce ", n, " bins.")) cut(x, brk , include.lowest = TRUE, ...) } @@ -60,7 +60,7 @@ cut_width <- function(x, width, center = NULL, boundary = NULL, closed = c("righ # Determine boundary if (!is.null(boundary) && !is.null(center)) { - stop("Only one of 'boundary' and 'center' may be specified.") + abort("Only one of 'boundary' and 'center' may be specified.") } if (is.null(boundary)) { if (is.null(center)) { @@ -93,7 +93,7 @@ find_origin <- function(x_range, width, boundary) { breaks <- function(x, equal, nbins = NULL, binwidth = NULL) { equal <- match.arg(equal, c("numbers", "width")) if ((!is.null(nbins) && !is.null(binwidth)) || (is.null(nbins) && is.null(binwidth))) { - stop("Specify exactly one of n and width") + abort("Specify exactly one of n and width") } rng <- range(x, na.rm = TRUE, finite = TRUE) diff --git a/R/utilities-grid.r b/R/utilities-grid.r index 811e1ab79f..7cc4d3e279 100644 --- a/R/utilities-grid.r +++ b/R/utilities-grid.r @@ -21,7 +21,7 @@ width_cm <- function(x) { } else if (is.list(x)) { vapply(x, width_cm, numeric(1)) } else { - stop("Unknown input") + abort("Unknown input") } } height_cm <- function(x) { @@ -32,6 +32,6 @@ height_cm <- function(x) { } else if (is.list(x)) { vapply(x, height_cm, numeric(1)) } else { - stop("Unknown input") + abort("Unknown input") } } diff --git a/R/utilities-matrix.r b/R/utilities-matrix.r index d0e9ed0d5d..694fc94f6f 100644 --- a/R/utilities-matrix.r +++ b/R/utilities-matrix.r @@ -24,7 +24,7 @@ interleave.default <- function(...) { # Check lengths lengths <- unique(setdiff(vapply(vectors, length, integer(1)), 1L)) if (length(lengths) == 0) lengths <- 1 - stopifnot(length(lengths) <= 1) + if (length(lengths) > 1) abort("`lengths` must be below 1") # Replicate elements of length one up to correct length singletons <- vapply(vectors, length, integer(1)) == 1L diff --git a/R/utilities.r b/R/utilities.r index 6336ace4b8..d66ba823f8 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -27,8 +27,8 @@ check_required_aesthetics <- function(required, present, name) { missing_aes <- setdiff(required, present) if (length(missing_aes) == 0) return() - stop(name, " requires the following missing aesthetics: ", - paste(missing_aes, collapse = ", "), call. = FALSE) + abort(paste0(name, " requires the following missing aesthetics: ", + paste(missing_aes, collapse = ", "))) } # Concatenate a named list for output @@ -52,8 +52,8 @@ try_require <- function(package, fun) { return(invisible()) } - stop("Package `", package, "` required for `", fun , "`.\n", - "Please install and try again.", call. = FALSE) + abort(paste0("Package `", package, "` required for `", fun , "`.\n", + "Please install and try again.")) } # Return unique columns @@ -83,7 +83,7 @@ uniquecols <- function(df) { #' @export remove_missing <- function(df, na.rm = FALSE, vars = names(df), name = "", finite = FALSE) { - stopifnot(is.logical(na.rm)) + if (!is.logical(na.rm)) abort("`na.rm` must be logical") vars <- intersect(vars, names(df)) if (name != "") name <- paste(" (", name, ")", sep = "") @@ -152,7 +152,7 @@ is_complete <- function(x) { #' should_stop(should_stop("Hi!")) should_stop <- function(expr) { res <- try(print(force(expr)), TRUE) - if (!inherits(res, "try-error")) stop("No error!", call. = FALSE) + if (!inherits(res, "try-error")) abort("No error!") invisible() } @@ -194,8 +194,7 @@ gg_dep <- function(version, msg) { # current minor number is more than 1 greater than last-good minor number, # give error. if (cv[[1,1]] > v[[1,1]] || cv[[1,2]] > v[[1,2]] + 1) { - stop(msg, " (Defunct; last used in version ", version, ")", - call. = FALSE) + abort(paste0(msg, " (Defunct; last used in version ", version, ")")) # If minor number differs by one, give warning } else if (cv[[1,2]] > v[[1,2]]) { @@ -226,11 +225,11 @@ to_lower_ascii <- function(x) chartr(upper_ascii, lower_ascii, x) to_upper_ascii <- function(x) chartr(lower_ascii, upper_ascii, x) tolower <- function(x) { - stop('Please use `to_lower_ascii()`, which works fine in all locales.', call. = FALSE) + abort(paste0('Please use `to_lower_ascii()`, which works fine in all locales.')) } toupper <- function(x) { - stop('Please use `to_upper_ascii()`, which works fine in all locales.', call. = FALSE) + abort(paste0('Please use `to_upper_ascii()`, which works fine in all locales.')) } # Convert a snake_case string to camelCase @@ -380,7 +379,7 @@ is_column_vec <- function(x) { # #> expression(alpha, NA, gamma) # parse_safe <- function(text) { - stopifnot(is.character(text)) + if (!is.character(text)) abort("`text` must be a character vector") out <- vector("expression", length(text)) for (i in seq_along(text)) { expr <- parse(text = text[[i]]) From ba04a23072c4fa91caf1094a789e96e8eefce469 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 10 Sep 2019 14:43:34 +0200 Subject: [PATCH 2/5] Convert warning to rlang::warn --- R/aes.r | 12 +++--------- R/coord-sf.R | 5 +---- R/coord-transform.r | 6 +++--- R/facet-wrap.r | 14 ++++++-------- R/geom-abline.r | 5 ++--- R/geom-bar.r | 3 +-- R/geom-boxplot.r | 2 +- R/geom-curve.r | 3 +-- R/geom-dotplot.r | 2 +- R/geom-path.r | 4 ++-- R/geom-raster.r | 4 ++-- R/grob-dotstack.r | 2 +- R/guide-colorbar.r | 8 +++++--- R/guide-legend.r | 2 +- R/labeller.r | 8 +++----- R/layer-sf.R | 2 +- R/layer.r | 5 ++--- R/position-collide.r | 2 +- R/position-dodge.r | 3 +-- R/position-dodge2.r | 3 +-- R/position-stack.r | 8 ++------ R/quick-plot.r | 4 ++-- R/scale-.r | 4 ++-- R/scale-alpha.r | 2 +- R/scale-brewer.r | 4 ++-- R/scale-shape.r | 2 +- R/scale-size.r | 2 +- R/stat-.r | 3 +-- R/stat-bin.r | 6 +++--- R/stat-boxplot.r | 4 +--- R/stat-contour.r | 2 +- R/stat-density.r | 2 +- R/stat-function.r | 4 ++-- R/theme-current.R | 3 +-- R/theme-elements.r | 6 +----- R/theme.r | 15 +++++---------- R/utilities.r | 5 ++--- 37 files changed, 68 insertions(+), 103 deletions(-) diff --git a/R/aes.r b/R/aes.r index f9dd9a44f4..cd5dd5540a 100644 --- a/R/aes.r +++ b/R/aes.r @@ -168,9 +168,7 @@ rename_aes <- function(x) { duplicated_names <- names(x)[duplicated(names(x))] if (length(duplicated_names) > 0L) { duplicated_message <- paste0(unique(duplicated_names), collapse = ", ") - warning( - "Duplicated aesthetics after name standardisation: ", duplicated_message, call. = FALSE - ) + warn(paste0("Duplicated aesthetics after name standardisation: ", duplicated_message)) } x } @@ -304,7 +302,7 @@ aes_all <- function(vars) { #' @keywords internal #' @export aes_auto <- function(data = NULL, ...) { - warning("aes_auto() is deprecated", call. = FALSE) + warn("aes_auto() is deprecated") # detect names of data if (is.null(data)) { @@ -357,11 +355,7 @@ warn_for_aes_extract_usage_expr <- function(x, data, env = emptyenv()) { if (is_call(x, "[[") || is_call(x, "$")) { if (extract_target_is_likely_data(x, data, env)) { good_usage <- alternative_aes_extract_usage(x) - warning( - "Use of `", format(x), "` is discouraged. ", - "Use `", good_usage, "` instead.", - call. = FALSE - ) + warn(paste0("Use of `", format(x), "` is discouraged. Use `", good_usage, "` instead.")) } } else if (is.call(x)) { lapply(x, warn_for_aes_extract_usage_expr, data, env) diff --git a/R/coord-sf.R b/R/coord-sf.R index 2d194c9467..b57cdcfb3f 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -167,10 +167,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian, backtransform_range = function(panel_params) { # this does not actually return backtransformed ranges in the general case, needs fixing - warning( - "range backtransformation not implemented in this coord; results may be wrong.", - call. = FALSE - ) + warn("range backtransformation not implemented in this coord; results may be wrong.") list(x = panel_params$x_range, y = panel_params$y_range) }, diff --git a/R/coord-transform.r b/R/coord-transform.r index 7b61c82094..d086d6b84f 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -77,11 +77,11 @@ coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL, limx = "DEPRECATED", limy = "DEPRECATED", clip = "on", expand = TRUE) { if (!missing(limx)) { - warning("`limx` argument is deprecated; please use `xlim` instead.", call. = FALSE) + warn("`limx` argument is deprecated; please use `xlim` instead.") xlim <- limx } if (!missing(limy)) { - warning("`limy` argument is deprecated; please use `ylim` instead.", call. = FALSE) + warn("`limy` argument is deprecated; please use `ylim` instead.") ylim <- limy } @@ -235,6 +235,6 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { #' @noRd warn_new_infinites <- function(old_values, new_values, axis) { if (any(is.finite(old_values) & !is.finite(new_values))) { - warning("Transformation introduced infinite values in ", axis, "-axis", call. = FALSE) + warn(paste0("Transformation introduced infinite values in ", axis, "-axis")) } } diff --git a/R/facet-wrap.r b/R/facet-wrap.r index b61f1253d9..bba38ef9f6 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -325,7 +325,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, !inside && any(!vapply(row_axes, is.zero, logical(1))) && !params$free$x) { - warning("Suppressing axis rendering when strip.position = 'bottom' and strip.placement == 'outside'", call. = FALSE) + warn("Suppressing axis rendering when strip.position = 'bottom' and strip.placement == 'outside'") } else { axis_mat_x_bottom[row_pos] <- row_axes } @@ -333,7 +333,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, !inside && any(!vapply(col_axes, is.zero, logical(1))) && !params$free$y) { - warning("Suppressing axis rendering when strip.position = 'right' and strip.placement == 'outside'", call. = FALSE) + warn("Suppressing axis rendering when strip.position = 'right' and strip.placement == 'outside'") } else { axis_mat_y_right[col_pos] <- col_axes } @@ -422,22 +422,20 @@ sanitise_dim <- function(n) { xname <- paste0("`", deparse(substitute(n)), "`") if (length(n) == 0) { if (!is.null(n)) { - warning(xname, " has length zero and will be treated as NULL.", - call. = FALSE) + warn(paste0(xname, " has length zero and will be treated as NULL.")) } return(NULL) } if (length(n) > 1) { - warning("Only the first value of ", xname, " will be used.", call. = FALSE) + warn(paste0("Only the first value of ", xname, " will be used.")) n <- n[1] } if (!is.numeric(n) || (!is.na(n) && n != round(n))) { - warning("Coercing ", xname, " to be an integer.", call. = FALSE) + warn(paste0("Coercing ", xname, " to be an integer.")) n <- as.integer(n) } if (is.na(n) || n < 1) { - warning(xname, " is missing or less than 1 and will be treated as NULL.", - call. = FALSE) + warn(paste0(xname, " is missing or less than 1 and will be treated as NULL.")) return(NULL) } n diff --git a/R/geom-abline.r b/R/geom-abline.r index a0ef5058b5..f11d1259e0 100644 --- a/R/geom-abline.r +++ b/R/geom-abline.r @@ -160,14 +160,13 @@ warn_overwritten_args <- function(fun_name, overwritten_arg, provided_args, plur verb <- "were" } - warning( + warn( sprintf( "%s: Ignoring %s because %s %s provided.", fun_name, overwritten_arg_text, provided_arg_text, verb - ), - call. = FALSE + ) ) } diff --git a/R/geom-bar.r b/R/geom-bar.r index 91d1767f3e..af033f8cf9 100644 --- a/R/geom-bar.r +++ b/R/geom-bar.r @@ -81,8 +81,7 @@ geom_bar <- function(mapping = NULL, data = NULL, inherit.aes = TRUE) { if (!is.null(binwidth)) { - warning("`geom_bar()` no longer has a `binwidth` parameter. ", - "Please use `geom_histogram()` instead.", call. = "FALSE") + warn("`geom_bar()` no longer has a `binwidth` parameter. Please use `geom_histogram()` instead.") return(geom_histogram(mapping = mapping, data = data, position = position, width = width, binwidth = binwidth, ..., na.rm = na.rm, show.legend = show.legend, inherit.aes = inherit.aes)) diff --git a/R/geom-boxplot.r b/R/geom-boxplot.r index 036a5e4271..72aca9e092 100644 --- a/R/geom-boxplot.r +++ b/R/geom-boxplot.r @@ -124,7 +124,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL, if (varwidth == TRUE) position <- position_dodge2(preserve = "single") } else { if (identical(position$preserve, "total") & varwidth == TRUE) { - warning("Can't preserve total widths when varwidth = TRUE.", call. = FALSE) + warn("Can't preserve total widths when varwidth = TRUE.") position$preserve <- "single" } } diff --git a/R/geom-curve.r b/R/geom-curve.r index e9faa3730b..9a44a85be3 100644 --- a/R/geom-curve.r +++ b/R/geom-curve.r @@ -45,8 +45,7 @@ GeomCurve <- ggproto("GeomCurve", GeomSegment, ncp = 5, arrow = NULL, arrow.fill = NULL, lineend = "butt", na.rm = FALSE) { if (!coord$is_linear()) { - warning("geom_curve is not implemented for non-linear coordinates", - call. = FALSE) + warn("geom_curve is not implemented for non-linear coordinates") } trans <- coord$transform(data, panel_params) diff --git a/R/geom-dotplot.r b/R/geom-dotplot.r index 3484835ff2..19b7444d8e 100644 --- a/R/geom-dotplot.r +++ b/R/geom-dotplot.r @@ -256,7 +256,7 @@ GeomDotplot <- ggproto("GeomDotplot", Geom, binaxis = "x", stackdir = "up", stackratio = 1, dotsize = 1, stackgroups = FALSE) { if (!coord$is_linear()) { - warning("geom_dotplot does not work properly with non-linear coordinates.") + warn("geom_dotplot does not work properly with non-linear coordinates.") } tdata <- coord$transform(data, panel_params) diff --git a/R/geom-path.r b/R/geom-path.r index 0a5835a5d0..c1babb353b 100644 --- a/R/geom-path.r +++ b/R/geom-path.r @@ -135,8 +135,8 @@ GeomPath <- ggproto("GeomPath", Geom, data <- data[kept, ] if (!all(kept) && !params$na.rm) { - warning("Removed ", sum(!kept), " rows containing missing values", - " (geom_path).", call. = FALSE) + warn(paste0("Removed ", sum(!kept), " rows containing missing values", + " (geom_path).")) } data diff --git a/R/geom-raster.r b/R/geom-raster.r index 62a3c680e5..11ee5edab7 100644 --- a/R/geom-raster.r +++ b/R/geom-raster.r @@ -57,7 +57,7 @@ GeomRaster <- ggproto("GeomRaster", Geom, if (length(x_diff) == 0) { w <- 1 } else if (any(abs(diff(x_diff)) > precision)) { - warning("Raster pixels are placed at uneven horizontal intervals and will be shifted. Consider using geom_tile() instead.") + warn("Raster pixels are placed at uneven horizontal intervals and will be shifted. Consider using geom_tile() instead.") w <- min(x_diff) } else { w <- x_diff[1] @@ -66,7 +66,7 @@ GeomRaster <- ggproto("GeomRaster", Geom, if (length(y_diff) == 0) { h <- 1 } else if (any(abs(diff(y_diff)) > precision)) { - warning("Raster pixels are placed at uneven vertical intervals and will be shifted. Consider using geom_tile() instead.") + warn("Raster pixels are placed at uneven vertical intervals and will be shifted. Consider using geom_tile() instead.") h <- min(y_diff) } else { h <- y_diff[1] diff --git a/R/grob-dotstack.r b/R/grob-dotstack.r index 48362a6976..dc25dc24eb 100644 --- a/R/grob-dotstack.r +++ b/R/grob-dotstack.r @@ -14,7 +14,7 @@ dotstackGrob <- function( if (!is.unit(dotdia)) dotdia <- unit(dotdia, default.units) if (!is_npc(dotdia)) - warning("Unit type of dotdia should be 'npc'") + warn("Unit type of dotdia should be 'npc'") grob(x = x, y = y, stackaxis = stackaxis, dotdia = dotdia, stackposition = stackposition, stackratio = stackratio, diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index ffe3f6abe8..d322d76274 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -195,12 +195,14 @@ guide_train.colorbar <- function(guide, scale, aesthetic = NULL) { # do nothing if scale are inappropriate if (length(intersect(scale$aesthetics, guide$available_aes)) == 0) { - warning("colourbar guide needs appropriate scales: ", - paste(guide$available_aes, collapse = ", ")) + warn(paste0( + "colourbar guide needs appropriate scales: ", + paste(guide$available_aes, collapse = ", ") + )) return(NULL) } if (scale$is_discrete()) { - warning("colourbar guide needs continuous scales.") + warn("colourbar guide needs continuous scales.") return(NULL) } diff --git a/R/guide-legend.r b/R/guide-legend.r index 67c00dea85..ea84cd1e7f 100644 --- a/R/guide-legend.r +++ b/R/guide-legend.r @@ -233,7 +233,7 @@ guide_merge.legend <- function(guide, new_guide) { guide$key <- merge(guide$key, new_guide$key, sort = FALSE) guide$override.aes <- c(guide$override.aes, new_guide$override.aes) if (any(duplicated(names(guide$override.aes)))) { - warning("Duplicated override.aes is ignored.") + warn("Duplicated override.aes is ignored.") } guide$override.aes <- guide$override.aes[!duplicated(names(guide$override.aes))] guide diff --git a/R/labeller.r b/R/labeller.r index 2cecc6a0fc..a9c33b1c86 100644 --- a/R/labeller.r +++ b/R/labeller.r @@ -213,8 +213,7 @@ label_bquote <- function(rows = NULL, cols = NULL, # but only if there is no facetted variable also named `x` if ("x" %in% find_names(quoted) && !"x" %in% names(params)) { if (!has_warned) { - warning("Referring to `x` is deprecated, use variable name instead", - call. = FALSE) + warn("Referring to `x` is deprecated, use variable name instead") # The function is called for each facet so this avoids # multiple warnings has_warned <<- TRUE @@ -697,9 +696,8 @@ check_labeller <- function(labeller) { labeller <- function(labels) { Map(old_labeller, names(labels), labels) } - warning("The labeller API has been updated. Labellers taking `variable`", - "and `value` arguments are now deprecated. See labellers documentation.", - call. = FALSE) + warn(paste0("The labeller API has been updated. Labellers taking `variable`", + "and `value` arguments are now deprecated. See labellers documentation.")) } labeller diff --git a/R/layer-sf.R b/R/layer-sf.R index 5560c04c88..4fb63b50d9 100644 --- a/R/layer-sf.R +++ b/R/layer-sf.R @@ -47,7 +47,7 @@ geom_column <- function(data) { } else { # this may not be best in case more than one geometry list-column is present: if (length(w) > 1) - warning("more than one geometry column present: taking the first") + warn("more than one geometry column present: taking the first") w[[1]] } } diff --git a/R/layer.r b/R/layer.r index 934d1216b2..1317215d3d 100644 --- a/R/layer.r +++ b/R/layer.r @@ -76,13 +76,12 @@ layer <- function(geom = NULL, stat = NULL, # Handle show_guide/show.legend if (!is.null(params$show_guide)) { - warning("`show_guide` has been deprecated. Please use `show.legend` instead.", - call. = FALSE) + warn("`show_guide` has been deprecated. Please use `show.legend` instead.") show.legend <- params$show_guide params$show_guide <- NULL } if (!is.logical(show.legend)) { - warning("`show.legend` must be a logical vector.", call. = FALSE) + warn("`show.legend` must be a logical vector.") show.legend <- FALSE } diff --git a/R/position-collide.r b/R/position-collide.r index e741480970..49978a9fe1 100644 --- a/R/position-collide.r +++ b/R/position-collide.r @@ -49,7 +49,7 @@ collide <- function(data, width = NULL, name, strategy, intervals <- intervals[!is.na(intervals)] if (length(unique(intervals)) > 1 & any(diff(scale(intervals)) < -1e-6)) { - warning(name, " requires non-overlapping x intervals", call. = FALSE) + warn(paste0(name, " requires non-overlapping x intervals", call. = FALSE)) # This is where the algorithm from [L. Wilkinson. Dot plots. # The American Statistician, 1999.] should be used } diff --git a/R/position-dodge.r b/R/position-dodge.r index dd9f67fe52..1caad3ad9d 100644 --- a/R/position-dodge.r +++ b/R/position-dodge.r @@ -90,8 +90,7 @@ PositionDodge <- ggproto("PositionDodge", Position, preserve = "total", setup_params = function(self, data) { if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { - warning("Width not defined. Set with `position_dodge(width = ?)`", - call. = FALSE) + warn("Width not defined. Set with `position_dodge(width = ?)`") } if (identical(self$preserve, "total")) { diff --git a/R/position-dodge2.r b/R/position-dodge2.r index 2bab0ba4fc..2fd4f4b757 100644 --- a/R/position-dodge2.r +++ b/R/position-dodge2.r @@ -25,8 +25,7 @@ PositionDodge2 <- ggproto("PositionDodge2", PositionDodge, setup_params = function(self, data) { if (is.null(data$xmin) && is.null(data$xmax) && is.null(self$width)) { - warning("Width not defined. Set with `position_dodge2(width = ?)`", - call. = FALSE) + warn("Width not defined. Set with `position_dodge2(width = ?)`") } if (identical(self$preserve, "total")) { diff --git a/R/position-stack.r b/R/position-stack.r index 7e42a8aef3..06513d9351 100644 --- a/R/position-stack.r +++ b/R/position-stack.r @@ -228,17 +228,13 @@ PositionFill <- ggproto("PositionFill", PositionStack, stack_var <- function(data) { if (!is.null(data$ymax)) { if (any(data$ymin != 0 & data$ymax != 0, na.rm = TRUE)) { - warning("Stacking not well defined when not anchored on the axis", call. = FALSE) + warn("Stacking not well defined when not anchored on the axis") } "ymax" } else if (!is.null(data$y)) { "y" } else { - warning( - "Stacking requires either ymin & ymin or y aesthetics.\n", - "Maybe you want position = 'identity'?", - call. = FALSE - ) + warn("Stacking requires either ymin & ymin or y aesthetics.\nMaybe you want position = 'identity'?") NULL } } diff --git a/R/quick-plot.r b/R/quick-plot.r index 4efa3b904d..153fb61d1a 100644 --- a/R/quick-plot.r +++ b/R/quick-plot.r @@ -67,8 +67,8 @@ qplot <- function(x, y, ..., data, facets = NULL, margins = FALSE, caller_env <- parent.frame() - if (!missing(stat)) warning("`stat` is deprecated", call. = FALSE) - if (!missing(position)) warning("`position` is deprecated", call. = FALSE) + if (!missing(stat)) warn("`stat` is deprecated") + if (!missing(position)) warn("`position` is deprecated") if (!is.character(geom)) abort("`geom` must be a character vector") exprs <- enquos(x = x, y = y, ...) diff --git a/R/scale-.r b/R/scale-.r index 16e2251d14..b7f8869ddb 100644 --- a/R/scale-.r +++ b/R/scale-.r @@ -475,7 +475,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (any(is.finite(x) != is.finite(new_x))) { type <- if (self$scale_name == "position_c") "continuous" else "discrete" axis <- if ("x" %in% self$aesthetics) "x" else "y" - warning("Transformation introduced infinite values in ", type, " ", axis, "-axis", call. = FALSE) + warn(paste0("Transformation introduced infinite values in ", type, " ", axis, "-axis")) } new_x }, @@ -670,7 +670,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, pal <- self$palette.cache } else { if (!is.null(self$n.breaks.cache)) { - warning("Cached palette does not match requested", call. = FALSE) + warn("Cached palette does not match requested") } pal <- self$palette(n) self$palette.cache <- pal diff --git a/R/scale-alpha.r b/R/scale-alpha.r index 967ae92d9a..8020d8d4a2 100644 --- a/R/scale-alpha.r +++ b/R/scale-alpha.r @@ -29,7 +29,7 @@ scale_alpha_continuous <- scale_alpha #' @rdname scale_alpha #' @export scale_alpha_discrete <- function(...) { - warning("Using alpha for a discrete variable is not advised.", call. = FALSE) + warn("Using alpha for a discrete variable is not advised.") scale_alpha_ordinal(...) } diff --git a/R/scale-brewer.r b/R/scale-brewer.r index ccbfc869ac..de9b9c9fa7 100644 --- a/R/scale-brewer.r +++ b/R/scale-brewer.r @@ -85,7 +85,7 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = - # warn about using a qualitative brewer palette to generate the gradient type <- match.arg(type, c("seq", "div", "qual")) if (type == "qual") { - warning("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + warn("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead") } continuous_scale(aesthetics, "distiller", gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ...) @@ -98,7 +98,7 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = - scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, values = NULL, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") { type <- match.arg(type, c("seq", "div", "qual")) if (type == "qual") { - warning("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead", call. = FALSE) + warn("Using a discrete colour palette in a continuous scale.\n Consider using type = \"seq\" or type = \"div\" instead") } continuous_scale(aesthetics, "distiller", gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ...) diff --git a/R/scale-shape.r b/R/scale-shape.r index 47dd7d9ebb..e00ff3281d 100644 --- a/R/scale-shape.r +++ b/R/scale-shape.r @@ -47,7 +47,7 @@ scale_shape_discrete <- scale_shape #' @export #' @usage NULL scale_shape_ordinal <- function(...) { - warning("Using shapes for an ordinal variable is not advised", call. = FALSE) + warn("Using shapes for an ordinal variable is not advised") scale_shape(...) } diff --git a/R/scale-size.r b/R/scale-size.r index fafc562e88..a46c859905 100644 --- a/R/scale-size.r +++ b/R/scale-size.r @@ -60,7 +60,7 @@ scale_size <- scale_size_continuous #' @export #' @usage NULL scale_size_discrete <- function(...) { - warning("Using size for a discrete variable is not advised.", call. = FALSE) + warn("Using size for a discrete variable is not advised.") scale_size_ordinal(...) } diff --git a/R/stat-.r b/R/stat-.r index 5ee8ce2056..44ce008547 100644 --- a/R/stat-.r +++ b/R/stat-.r @@ -89,8 +89,7 @@ Stat <- ggproto("Stat", dapply(data, "PANEL", function(data) { scales <- layout$get_scales(data$PANEL[1]) tryCatch(do.call(self$compute_panel, args), error = function(e) { - warning("Computation failed in `", snake_class(self), "()`:\n", - e$message, call. = FALSE) + warn(paste0("Computation failed in `", snake_class(self), "()`:\n", e$message)) new_data_frame() }) }) diff --git a/R/stat-bin.r b/R/stat-bin.r index 0cef308727..32cbde6cd1 100644 --- a/R/stat-bin.r +++ b/R/stat-bin.r @@ -90,16 +90,16 @@ StatBin <- ggproto("StatBin", Stat, } if (!is.null(params$drop)) { - warning("`drop` is deprecated. Please use `pad` instead.", call. = FALSE) + warn("`drop` is deprecated. Please use `pad` instead.") params$drop <- NULL } if (!is.null(params$origin)) { - warning("`origin` is deprecated. Please use `boundary` instead.", call. = FALSE) + warn("`origin` is deprecated. Please use `boundary` instead.") params$boundary <- params$origin params$origin <- NULL } if (!is.null(params$right)) { - warning("`right` is deprecated. Please use `closed` instead.", call. = FALSE) + warn("`right` is deprecated. Please use `closed` instead.") params$closed <- if (params$right) "right" else "left" params$right <- NULL } diff --git a/R/stat-boxplot.r b/R/stat-boxplot.r index 618d57e99c..21199d8857 100644 --- a/R/stat-boxplot.r +++ b/R/stat-boxplot.r @@ -59,9 +59,7 @@ StatBoxplot <- ggproto("StatBoxplot", Stat, params$width <- params$width %||% (resolution(data$x %||% 0) * 0.75) if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { - warning( - "Continuous x aesthetic -- did you forget aes(group=...)?", - call. = FALSE) + warn("Continuous x aesthetic -- did you forget aes(group=...)?") } params diff --git a/R/stat-contour.r b/R/stat-contour.r index ed287a5a27..8238929e37 100644 --- a/R/stat-contour.r +++ b/R/stat-contour.r @@ -209,7 +209,7 @@ iso_to_path <- function(iso, group = 1) { lengths <- vapply(iso, function(x) length(x$x), integer(1)) if (all(lengths == 0)) { - warning("stat_contour(): Zero contours were generated", call. = FALSE) + warn("stat_contour(): Zero contours were generated") return(new_data_frame()) } diff --git a/R/stat-density.r b/R/stat-density.r index 6d18b8bb12..a75d73f65c 100644 --- a/R/stat-density.r +++ b/R/stat-density.r @@ -91,7 +91,7 @@ compute_density <- function(x, w, from, to, bw = "nrd0", adjust = 1, # if less than 2 points return data frame of NAs and a warning if (nx < 2) { - warning("Groups with fewer than two data points have been dropped.", call. = FALSE) + warn("Groups with fewer than two data points have been dropped.") return(new_data_frame(list( x = NA_real_, density = NA_real_, diff --git a/R/stat-function.r b/R/stat-function.r index 8db4c2b64a..fed00239f6 100644 --- a/R/stat-function.r +++ b/R/stat-function.r @@ -67,10 +67,10 @@ stat_function <- function(mapping = NULL, data = NULL, # Warn if supplied mapping and/or data is going to be overwritten if (!is.null(mapping)) { - warning("`mapping` is not used by stat_function()", call. = FALSE) + warn("`mapping` is not used by stat_function()") } if (!is.null(data)) { - warning("`data` is not used by stat_function()", call. = FALSE) + warn("`data` is not used by stat_function()") } layer( diff --git a/R/theme-current.R b/R/theme-current.R index 47d306a702..3b3180db7b 100644 --- a/R/theme-current.R +++ b/R/theme-current.R @@ -74,8 +74,7 @@ theme_get <- function() { theme_set <- function(new) { missing <- setdiff(names(theme_gray()), names(new)) if (length(missing) > 0) { - warning("New theme missing the following elements: ", - paste(missing, collapse = ", "), call. = FALSE) + warn(paste0("New theme missing the following elements: ", paste(missing, collapse = ", "))) } old <- ggplot_global$theme_current diff --git a/R/theme-elements.r b/R/theme-elements.r index ee84543fba..835c1a07ee 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -118,11 +118,7 @@ element_text <- function(family = NULL, face = NULL, colour = NULL, length(hjust), length(vjust), length(angle), length(lineheight) ) if (n > 1) { - warning( - "Vectorized input to `element_text()` is not officially supported.\n", - "Results may be unexpected or may change in future versions of ggplot2.", - call. = FALSE - ) + warn("Vectorized input to `element_text()` is not officially supported.\nResults may be unexpected or may change in future versions of ggplot2.") } diff --git a/R/theme.r b/R/theme.r index 9ff5e01391..5e96b90606 100644 --- a/R/theme.r +++ b/R/theme.r @@ -363,31 +363,26 @@ theme <- function(line, elements <- find_args(..., complete = NULL, validate = NULL) if (!is.null(elements$axis.ticks.margin)) { - warning("`axis.ticks.margin` is deprecated. Please set `margin` property ", - " of `axis.text` instead", call. = FALSE) + warn("`axis.ticks.margin` is deprecated. Please set `margin` property of `axis.text` instead") elements$axis.ticks.margin <- NULL } if (!is.null(elements$panel.margin)) { - warning("`panel.margin` is deprecated. Please use `panel.spacing` property ", - "instead", call. = FALSE) + warn("`panel.margin` is deprecated. Please use `panel.spacing` property instead") elements$panel.spacing <- elements$panel.margin elements$panel.margin <- NULL } if (!is.null(elements$panel.margin.x)) { - warning("`panel.margin.x` is deprecated. Please use `panel.spacing.x` property ", - "instead", call. = FALSE) + warn("`panel.margin.x` is deprecated. Please use `panel.spacing.x` property instead") elements$panel.spacing.x <- elements$panel.margin.x elements$panel.margin.x <- NULL } if (!is.null(elements$panel.margin.y)) { - warning("`panel.margin` is deprecated. Please use `panel.spacing` property ", - "instead", call. = FALSE) + warn("`panel.margin` is deprecated. Please use `panel.spacing` property instead") elements$panel.spacing.y <- elements$panel.margin.y elements$panel.margin.y <- NULL } if (is.unit(elements$legend.margin) && !is.margin(elements$legend.margin)) { - warning("`legend.margin` must be specified using `margin()`. For the old ", - "behavior use legend.spacing", call. = FALSE) + warn("`legend.margin` must be specified using `margin()`. For the old behavior use legend.spacing") elements$legend.spacing <- elements$legend.margin elements$legend.margin <- margin() } diff --git a/R/utilities.r b/R/utilities.r index d66ba823f8..cdffb737ea 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -198,8 +198,7 @@ gg_dep <- function(version, msg) { # If minor number differs by one, give warning } else if (cv[[1,2]] > v[[1,2]]) { - warning(msg, " (Deprecated; last used in version ", version, ")", - call. = FALSE) + warn(paste0(msg, " (Deprecated; last used in version ", version, ")")) # If only subminor number is greater, give message } else if (cv[[1,3]] > v[[1,3]]) { @@ -295,7 +294,7 @@ message_wrap <- function(...) { warning_wrap <- function(...) { msg <- paste(..., collapse = "", sep = "") wrapped <- strwrap(msg, width = getOption("width") - 2) - warning(paste0(wrapped, collapse = "\n"), call. = FALSE) + warn(paste0(wrapped, collapse = "\n")) } var_list <- function(x) { From 394ce284cde5ec813ee63e11dd36ed2e948d959f Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 11 Sep 2019 10:30:10 +0200 Subject: [PATCH 3/5] Use glue for creating exception messages --- DESCRIPTION | 3 ++- NAMESPACE | 2 ++ R/aes.r | 6 ++++-- R/annotation-map.r | 8 ++++++-- R/autolayer.r | 7 +++++-- R/autoplot.r | 7 +++++-- R/bench.r | 4 +++- R/compat-plyr.R | 2 +- R/coord-transform.r | 2 +- R/facet-wrap.r | 6 ++++-- R/geom-.r | 6 +++--- R/geom-abline.r | 10 +--------- R/geom-label.R | 4 +++- R/geom-map.r | 8 ++++++-- R/geom-point.r | 16 ++++++---------- R/ggplot2.r | 1 + R/guide-colorbar.r | 8 ++++++-- R/guides-.r | 12 +++++++----- R/guides-axis.r | 2 +- R/labeller.r | 6 ++++-- R/layer.r | 7 +++---- R/layout.R | 4 +++- R/limits.r | 16 ++++++++++++---- R/performance.R | 18 ++++++++++++++---- R/plot.r | 5 ++++- R/quick-plot.r | 4 +++- R/save.r | 9 +++++---- R/scale-manual.r | 3 +-- R/theme-elements.r | 8 ++++---- R/theme.r | 10 ++++++---- R/utilities.r | 35 +++++++++++++++++++++++------------ 31 files changed, 149 insertions(+), 90 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 95cb820686..6628fff151 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,7 +31,8 @@ Imports: stats, tibble, viridisLite, - withr (>= 2.0.0) + withr (>= 2.0.0), + glue Suggests: covr, dplyr, diff --git a/NAMESPACE b/NAMESPACE index 3670510528..a91135c852 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -586,6 +586,8 @@ import(grid) import(gtable) import(rlang) import(scales) +importFrom(glue,glue) +importFrom(glue,glue_collapse) importFrom(stats,setNames) importFrom(tibble,tibble) importFrom(utils,.DollarNames) diff --git a/R/aes.r b/R/aes.r index cd5dd5540a..fb0f14e81f 100644 --- a/R/aes.r +++ b/R/aes.r @@ -102,7 +102,9 @@ new_aesthetic <- function(x, env = globalenv()) { x } new_aes <- function(x, env = globalenv()) { - if (!is.list(x)) abort("`x` must be a list") + if (!is.list(x)) { + abort("`x` must be a list") + } x <- lapply(x, new_aesthetic, env = env) structure(x, class = "uneval") } @@ -369,7 +371,7 @@ alternative_aes_extract_usage <- function(x) { } else if (is_call(x, "$")) { as.character(x[[3]]) } else { - abort(paste0("Don't know how to get alternative usage for `", format(x), "`")) + abort(glue("Don't know how to get alternative usage for `{format(x)}`")) } } diff --git a/R/annotation-map.r b/R/annotation-map.r index fde5b1cb84..7df95283b7 100644 --- a/R/annotation-map.r +++ b/R/annotation-map.r @@ -31,11 +31,15 @@ NULL #' } annotation_map <- function(map, ...) { # Get map input into correct form - if (!is.data.frame(map)) abort("`map` must be a data.frame") + if (!is.data.frame(map)) { + abort("`map` must be a data.frame") + } if (!is.null(map$lat)) map$y <- map$lat if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region - if (!all(c("x", "y", "id") %in% names(map))) abort("`map`must have the columns `x`, `y`, and `id`") + if (!all(c("x", "y", "id") %in% names(map))) { + abort("`map`must have the columns `x`, `y`, and `id`") + } layer( data = dummy_data(), diff --git a/R/autolayer.r b/R/autolayer.r index 5af86fd2c1..db371f4d4a 100644 --- a/R/autolayer.r +++ b/R/autolayer.r @@ -15,6 +15,9 @@ autolayer <- function(object, ...) { #' @export autolayer.default <- function(object, ...) { - abort(paste0("Objects of type ", paste(class(object), collapse = "/"), - " not supported by autolayer.")) + abort(glue( + "Objects of type ", + glue_collapse(class(object), "/"), + " not supported by autolayer." + )) } diff --git a/R/autoplot.r b/R/autoplot.r index 16558cc928..fb5f8665a5 100644 --- a/R/autoplot.r +++ b/R/autoplot.r @@ -15,7 +15,10 @@ autoplot <- function(object, ...) { #' @export autoplot.default <- function(object, ...) { - abort(paste0("Objects of type ", paste(class(object), collapse = "/"), - " not supported by autoplot.")) + abort(glue( + "Objects of type ", + glue_collapse(class(object), "/"), + " not supported by autoplot." + )) } diff --git a/R/bench.r b/R/bench.r index d394bb334f..2ee31050e0 100644 --- a/R/bench.r +++ b/R/bench.r @@ -15,7 +15,9 @@ benchplot <- function(x) { x <- enquo(x) construct <- system.time(x <- eval_tidy(x)) - if (!inherits(x, "ggplot")) abort("`x` must be a ggplot object") + if (!inherits(x, "ggplot")) { + abort("`x` must be a ggplot object") + } build <- system.time(data <- ggplot_build(x)) render <- system.time(grob <- ggplot_gtable(data)) diff --git a/R/compat-plyr.R b/R/compat-plyr.R index ab1b16fe70..f6e3d4d6ae 100644 --- a/R/compat-plyr.R +++ b/R/compat-plyr.R @@ -246,7 +246,7 @@ as.quoted <- function(x, env = parent.frame()) { } # round a number to a given precision round_any <- function(x, accuracy, f = round) { - if (!is.numeric(x)) abort("`x`` must be numeric") + if (!is.numeric(x)) abort("`x` must be numeric") f(x/accuracy) * accuracy } #' Bind data frames together by common column names diff --git a/R/coord-transform.r b/R/coord-transform.r index d086d6b84f..358b8ecb91 100644 --- a/R/coord-transform.r +++ b/R/coord-transform.r @@ -235,6 +235,6 @@ train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) { #' @noRd warn_new_infinites <- function(old_values, new_values, axis) { if (any(is.finite(old_values) & !is.finite(new_values))) { - warn(paste0("Transformation introduced infinite values in ", axis, "-axis")) + warn(glue("Transformation introduced infinite values in {axis}-axis")) } } diff --git a/R/facet-wrap.r b/R/facet-wrap.r index bba38ef9f6..2f017f9d83 100644 --- a/R/facet-wrap.r +++ b/R/facet-wrap.r @@ -211,7 +211,7 @@ FacetWrap <- ggproto("FacetWrap", Facet, }, draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord, data, theme, params) { if ((params$free$x || params$free$y) && !coord$is_free()) { - abort(paste0(snake_class(coord), " doesn't support free scales")) + abort(glue("{snake_class(coord)} doesn't support free scales")) } if (inherits(coord, "CoordFlip")) { @@ -460,7 +460,9 @@ wrap_dims <- function(n, nrow = NULL, ncol = NULL) { } else if (is.null(nrow)) { nrow <- ceiling(n / ncol) } - if (nrow * ncol < n) abort("the given dimensions cannot hold all panels") + if (nrow * ncol < n) { + abort("The given dimensions cannot hold all panels. Please increase `ncol` or `nrow`") + } c(nrow, ncol) } diff --git a/R/geom-.r b/R/geom-.r index 342d469b44..586a625dd2 100644 --- a/R/geom-.r +++ b/R/geom-.r @@ -184,8 +184,8 @@ check_aesthetics <- function(x, n) { return() } - abort(paste0( - "Aesthetics must be either length 1 or the same as the data (", n, "): ", - paste(names(which(!good)), collapse = ", ") + abort(glue( + "Aesthetics must be either length 1 or the same as the data ({n}): ", + glue_collapse(names(which(!good)), ", ", last = " and ") )) } diff --git a/R/geom-abline.r b/R/geom-abline.r index f11d1259e0..60161c1fc1 100644 --- a/R/geom-abline.r +++ b/R/geom-abline.r @@ -160,13 +160,5 @@ warn_overwritten_args <- function(fun_name, overwritten_arg, provided_args, plur verb <- "were" } - warn( - sprintf( - "%s: Ignoring %s because %s %s provided.", - fun_name, - overwritten_arg_text, - provided_arg_text, - verb - ) - ) + warn(glue("{fun_name}: Ignoring {overwritten_arg_text} because {provided_arg_text} {verb} provided.")) } diff --git a/R/geom-label.R b/R/geom-label.R index dffff0497f..826d16a72b 100644 --- a/R/geom-label.R +++ b/R/geom-label.R @@ -109,7 +109,9 @@ labelGrob <- function(label, x = unit(0.5, "npc"), y = unit(0.5, "npc"), default.units = "npc", name = NULL, text.gp = gpar(), rect.gp = gpar(fill = "white"), vp = NULL) { - if (length(label) != 1) abort("label must be of length 1") + if (length(label) != 1) { + abort("label must be of length 1") + } if (!is.unit(x)) x <- unit(x, default.units) diff --git a/R/geom-map.r b/R/geom-map.r index 095362571e..9d9c526dab 100644 --- a/R/geom-map.r +++ b/R/geom-map.r @@ -67,11 +67,15 @@ geom_map <- function(mapping = NULL, data = NULL, show.legend = NA, inherit.aes = TRUE) { # Get map input into correct form - if (!is.data.frame(map)) abort("`map` must be a data.frame") + if (!is.data.frame(map)) { + abort("`map` must be a data.frame") + } if (!is.null(map$lat)) map$y <- map$lat if (!is.null(map$long)) map$x <- map$long if (!is.null(map$region)) map$id <- map$region - if (!all(c("x", "y", "id") %in% names(map))) abort("`map` must have the columns `x`, `y`, and `id`") + if (!all(c("x", "y", "id") %in% names(map))) { + abort("`map` must have the columns `x`, `y`, and `id`") + } layer( data = data, diff --git a/R/geom-point.r b/R/geom-point.r index b2286f03f9..88e1e6655f 100644 --- a/R/geom-point.r +++ b/R/geom-point.r @@ -185,13 +185,11 @@ translate_shape_string <- function(shape_string) { more_problems <- if (n_bad > 5) { sprintf("\n* ... and %d more problem%s", n_bad - 5, ifelse(n_bad > 6, "s", "")) + } else { + "" } - abort(paste0( - "Can't find shape name:", - collapsed_names, - more_problems - )) + abort(glue("Can't find shape name:", collapsed_names, more_problems)) } if (any(nonunique_strings)) { @@ -211,13 +209,11 @@ translate_shape_string <- function(shape_string) { more_problems <- if (n_bad > 5) { sprintf("\n* ... and %d more problem%s", n_bad - 5, ifelse(n_bad > 6, "s", "")) + } else { + "" } - abort(paste0( - "Shape names must be unambiguous:", - collapsed_names, - more_problems - )) + abort(glue("Shape names must be unambiguous:", collapsed_names, more_problems)) } unname(pch_table[shape_match]) diff --git a/R/ggplot2.r b/R/ggplot2.r index 8c44df5540..0cdacd84cd 100644 --- a/R/ggplot2.r +++ b/R/ggplot2.r @@ -3,4 +3,5 @@ #' @import scales grid gtable rlang #' @importFrom stats setNames +#' @importFrom glue glue glue_collapse NULL diff --git a/R/guide-colorbar.r b/R/guide-colorbar.r index d322d76274..9baeeee487 100644 --- a/R/guide-colorbar.r +++ b/R/guide-colorbar.r @@ -284,13 +284,17 @@ guide_gengrob.colorbar <- function(guide, theme) { # settings of location and size if (guide$direction == "horizontal") { label.position <- guide$label.position %||% "bottom" - if (!label.position %in% c("top", "bottom")) abort(paste0("label position \"", label.position, "\" is invalid")) + if (!label.position %in% c("top", "bottom")) { + abort(glue("label position '{label.position}' is invalid")) + } barwidth <- width_cm(guide$barwidth %||% (theme$legend.key.width * 5)) barheight <- height_cm(guide$barheight %||% theme$legend.key.height) } else { # guide$direction == "vertical" label.position <- guide$label.position %||% "right" - if (!label.position %in% c("left", "right")) abort(paste0("label position \"", label.position, "\" is invalid")) + if (!label.position %in% c("left", "right")) { + abort(glue("label position '{label.position}' is invalid")) + } barwidth <- width_cm(guide$barwidth %||% theme$legend.key.width) barheight <- height_cm(guide$barheight %||% (theme$legend.key.height * 5)) diff --git a/R/guides-.r b/R/guides-.r index c6fb06d57c..d1ad31ecc1 100644 --- a/R/guides-.r +++ b/R/guides-.r @@ -156,7 +156,7 @@ validate_guide <- function(guide) { else if (inherits(guide, "guide")) guide else - abort(paste0("Unknown guide: ", guide)) + abort(glue("Unknown guide: {guide}")) } # train each scale in scales and generate the definition of guide @@ -182,8 +182,9 @@ guides_train <- function(scales, theme, guides, labels) { guide <- validate_guide(guide) # check the consistency of the guide and scale. - if (!identical(guide$available_aes, "any") && !any(scale$aesthetics %in% guide$available_aes)) - abort(paste0("Guide '", guide$name, "' cannot be used for '", scale$aesthetics, "'.")) + if (!identical(guide$available_aes, "any") && !any(scale$aesthetics %in% guide$available_aes)) { + abort(glue("Guide '{guide$name}' cannot be used for '{scale$aesthetics}'.")) + } guide$title <- scale$make_title(guide$title %|W|% scale$name %|W|% labels[[output]]) @@ -226,8 +227,9 @@ guides_gengrob <- function(gdefs, theme) { gdefs <- lapply(gdefs, function(g) { g$title.position <- g$title.position %||% switch(g$direction, vertical = "top", horizontal = "left") - if (!g$title.position %in% c("top", "bottom", "left", "right")) - abort(paste0("title position \"", g$title.position, "\" is invalid")) + if (!g$title.position %in% c("top", "bottom", "left", "right")) { + abort(glue("title position '{g$title.position}' is invalid")) + } g }) diff --git a/R/guides-axis.r b/R/guides-axis.r index c206f0bfb9..9f37179a3f 100644 --- a/R/guides-axis.r +++ b/R/guides-axis.r @@ -253,6 +253,6 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { vjust = if (angle > 0) 1 else if (angle < 0) 0 else 0.5, ) } else { - abort(paste0("Unrecognized position: '", axis_position, "'")) + abort(glue("Unrecognized position: '{axis_position}'")) } } diff --git a/R/labeller.r b/R/labeller.r index a9c33b1c86..2cd0821a14 100644 --- a/R/labeller.r +++ b/R/labeller.r @@ -445,8 +445,10 @@ labeller <- function(..., .rows = NULL, .cols = NULL, # Check that variable-specific labellers do not overlap with # margin-wide labeller if (any(names(dots) %in% names(labels))) { - abort(paste0("Conflict between .", attr(labels, "type"), " and ", - paste(names(dots), collapse = ", "))) + abort(glue( + "Conflict between .{attr(labels, 'type')} and ", + glue_collapse(names(dots), ", ", last = " and ") + )) } } diff --git a/R/layer.r b/R/layer.r index 1317215d3d..b86e627544 100644 --- a/R/layer.r +++ b/R/layer.r @@ -388,14 +388,13 @@ check_subclass <- function(x, subclass, obj <- find_global(name, env = env) if (is.null(obj) || !inherits(obj, subclass)) { - abort(paste0("Can't find `", argname, "` called \"", x, "\"")) + abort(glue("Can't find `{argname}` called '{x}'")) } else { obj } } else { - abort(paste0( - "`", argname, "` must be either a string or a ", subclass, " object, ", - "not ", obj_desc(x) + abort(glue( + "`{argname}` must be either a string or a {subclass} object, not {obj_desc(x)}" )) } } diff --git a/R/layout.R b/R/layout.R index 3f0de90d7b..0af5fbd52e 100644 --- a/R/layout.R +++ b/R/layout.R @@ -270,7 +270,9 @@ scale_apply <- function(data, vars, method, scale_id, scales) { if (length(vars) == 0) return() if (nrow(data) == 0) return() - if (any(is.na(scale_id))) abort("`scale_id`` must not be `NA`") + if (any(is.na(scale_id))) { + abort("`scale_id` must not be `NA`") + } scale_index <- unname(split( seq_along(scale_id), diff --git a/R/limits.r b/R/limits.r index 55d62bf1b0..b03670ce00 100644 --- a/R/limits.r +++ b/R/limits.r @@ -108,7 +108,9 @@ ylim <- function(...) { limits <- function(lims, var) UseMethod("limits") #' @export limits.numeric <- function(lims, var) { - if (length(lims) != 2) abort("lims must be a two-element vector") + if (length(lims) != 2) { + abort("`lims` must be a two-element vector") + } if (!any(is.na(lims)) && lims[1] > lims[2]) { trans <- "reverse" } else { @@ -133,17 +135,23 @@ limits.factor <- function(lims, var) { } #' @export limits.Date <- function(lims, var) { - if (length(lims) != 2) abort("lims must be a two-element vector") + if (length(lims) != 2) { + abort("`lims` must be a two-element vector") + } make_scale("date", var, limits = lims) } #' @export limits.POSIXct <- function(lims, var) { - if (length(lims) != 2) abort("lims must be a two-element vector") + if (length(lims) != 2) { + abort("`lims` must be a two-element vector") + } make_scale("datetime", var, limits = lims) } #' @export limits.POSIXlt <- function(lims, var) { - if (length(lims) != 2) abort("lims must be a two-element vector") + if (length(lims) != 2) { + abort("`lims` must be a two-element vector") + } make_scale("datetime", var, limits = as.POSIXct(lims)) } diff --git a/R/performance.R b/R/performance.R index 9c96ede298..8ed0e53da3 100644 --- a/R/performance.R +++ b/R/performance.R @@ -1,14 +1,18 @@ # Fast data.frame constructor and indexing # No checking, recycling etc. unless asked for new_data_frame <- function(x = list(), n = NULL) { - if (length(x) != 0 && is.null(names(x))) abort("Elements must be named") + if (length(x) != 0 && is.null(names(x))) { + abort("Elements must be named") + } lengths <- vapply(x, length, integer(1)) if (is.null(n)) { n <- if (length(x) == 0 || min(lengths) == 0) 0 else max(lengths) } for (i in seq_along(x)) { if (lengths[i] == n) next - if (lengths[i] != 1) abort("Elements must equal the number of rows or 1") + if (lengths[i] != 1) { + abort("Elements must equal the number of rows or 1") + } x[[i]] <- rep(x[[i]], n) } @@ -23,7 +27,10 @@ data_frame <- function(...) { } data.frame <- function(...) { - abort('Please use `data_frame()` or `new_data_frame()` instead of `data.frame()` for better performance. See the vignette "ggplot2 internal programming guidelines" for details.') + abort(glue(" + Please use `data_frame()` or `new_data_frame()` instead of `data.frame()` for better performance. + See the vignette 'ggplot2 internal programming guidelines' for details. + ")) } split_matrix <- function(x, col_names = colnames(x)) { @@ -49,5 +56,8 @@ modify_list <- function(old, new) { old } modifyList <- function(...) { - abort('Please use `modify_list()` instead of `modifyList()` for better performance. See the vignette "ggplot2 internal programming guidelines" for details.') + abort(glue(" + Please use `modify_list()` instead of `modifyList()` for better performance. + See the vignette 'ggplot2 internal programming guidelines' for details. + ")) } diff --git a/R/plot.r b/R/plot.r index 77b8191102..0290b6e5c9 100644 --- a/R/plot.r +++ b/R/plot.r @@ -106,7 +106,10 @@ ggplot.default <- function(data = NULL, mapping = aes(), ..., ggplot.function <- function(data = NULL, mapping = aes(), ..., environment = parent.frame()) { # Added to avoid functions end in ggplot.default - abort("You're passing a function as global data.\nHave you misspelled the `data` argument in `ggplot()`") + abort(glue(" + You're passing a function as global data. + Have you misspelled the `data` argument in `ggplot()` + ")) } plot_clone <- function(plot) { diff --git a/R/quick-plot.r b/R/quick-plot.r index 153fb61d1a..12038693ad 100644 --- a/R/quick-plot.r +++ b/R/quick-plot.r @@ -69,7 +69,9 @@ qplot <- function(x, y, ..., data, facets = NULL, margins = FALSE, if (!missing(stat)) warn("`stat` is deprecated") if (!missing(position)) warn("`position` is deprecated") - if (!is.character(geom)) abort("`geom` must be a character vector") + if (!is.character(geom)) { + abort("`geom` must be a character vector") + } exprs <- enquos(x = x, y = y, ...) is_missing <- vapply(exprs, quo_is_missing, logical(1)) diff --git a/R/save.r b/R/save.r index 64db31c58d..19cad7ab0f 100644 --- a/R/save.r +++ b/R/save.r @@ -120,9 +120,10 @@ plot_dim <- function(dim = c(NA, NA), scale = 1, units = c("in", "cm", "mm"), } if (limitsize && any(dim >= 50)) { - abort(paste0("Dimensions exceed 50 inches (height and width are specified in '", - units, "' not pixels). If you're sure you want a plot that big, use ", - "`limitsize = FALSE`.")) + abort(glue(" + Dimensions exceed 50 inches (height and width are specified in '{units}' not pixels). + If you're sure you want a plot that big, use `limitsize = FALSE`. + ")) } dim @@ -164,7 +165,7 @@ plot_dev <- function(device, filename = NULL, dpi = 300) { dev <- devices[[device]] if (is.null(dev)) { - abort(paste0("Unknown graphics device '", device, "'")) + abort(glue("Unknown graphics device '{device}'")) } dev } diff --git a/R/scale-manual.r b/R/scale-manual.r index 0079755fac..9394ded9d5 100644 --- a/R/scale-manual.r +++ b/R/scale-manual.r @@ -126,8 +126,7 @@ manual_scale <- function(aesthetic, values = NULL, ...) { pal <- function(n) { if (n > length(values)) { - abort(paste0("Insufficient values in manual scale. ", n, " needed but only ", - length(values), " provided.")) + abort(glue("Insufficient values in manual scale. {n} needed but only {length(values)} provided.")) } values } diff --git a/R/theme-elements.r b/R/theme-elements.r index 835c1a07ee..ddcaaf20a9 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -393,7 +393,7 @@ validate_element <- function(el, elname) { eldef <- ggplot_global$element_tree[[elname]] if (is.null(eldef)) { - abort(paste0('"', elname, '" is not a valid theme element name.')) + abort(glue("'{elname}' is not a valid theme element name.")) } # NULL values for elements are OK @@ -403,12 +403,12 @@ validate_element <- function(el, elname) { # Need to be a bit looser here since sometimes it's a string like "top" # but sometimes its a vector like c(0,0) if (!is.character(el) && !is.numeric(el)) - abort(paste0("Element ", elname, " must be a string or numeric vector.")) + abort(glue("Element {elname} must be a string or numeric vector.")) } else if (eldef$class == "margin") { if (!is.unit(el) && length(el) == 4) - abort(paste0("Element ", elname, " must be a unit vector of length 4.")) + abort(glue("Element {elname} must be a unit vector of length 4.")) } else if (!inherits(el, eldef$class) && !inherits(el, "element_blank")) { - abort(paste0("Element ", elname, " must be a ", eldef$class, " object.")) + abort(glue("Element {elname} must be a {eldef$class} object.")) } invisible() } diff --git a/R/theme.r b/R/theme.r index 5e96b90606..b4275e8bf5 100644 --- a/R/theme.r +++ b/R/theme.r @@ -543,7 +543,7 @@ calc_element <- function(element, theme, verbose = FALSE) { # it is of the class specified in .element_tree if (!is.null(theme[[element]]) && !inherits(theme[[element]], ggplot_global$element_tree[[element]]$class)) { - abort(paste0(element, " should have class ", ggplot_global$element_tree[[element]]$class)) + abort(glue("{element} should have class {ggplot_global$element_tree[[element]]$class}")) } # Get the names of parents from the inheritance tree @@ -554,8 +554,10 @@ calc_element <- function(element, theme, verbose = FALSE) { # Check that all the properties of this element are non-NULL nullprops <- vapply(theme[[element]], is.null, logical(1)) if (any(nullprops)) { - abort(paste0("Theme element '", element, "' has NULL property: ", - paste(names(nullprops)[nullprops], collapse = ", "))) + abort(glue( + "Theme element '{element}' has NULL property: ", + glue_collapse(names(nullprops)[nullprops], ", ", last = " and ") + )) } if (verbose) message("nothing (top level)") @@ -594,7 +596,7 @@ merge_element <- function(new, old) { #' @rdname merge_element #' @export merge_element.default <- function(new, old) { - abort(paste0("No method for merging ", class(new)[1], " into ", class(old)[1])) + abort(glue("No method for merging {class(new)[1]} into {class(old)[1]}")) } #' @rdname merge_element #' @export diff --git a/R/utilities.r b/R/utilities.r index cdffb737ea..d131e1784f 100644 --- a/R/utilities.r +++ b/R/utilities.r @@ -27,8 +27,10 @@ check_required_aesthetics <- function(required, present, name) { missing_aes <- setdiff(required, present) if (length(missing_aes) == 0) return() - abort(paste0(name, " requires the following missing aesthetics: ", - paste(missing_aes, collapse = ", "))) + abort(glue( + "{name} requires the following missing aesthetics: ", + glue_collapse(missing_aes, ", ", last = " and ") + )) } # Concatenate a named list for output @@ -52,8 +54,10 @@ try_require <- function(package, fun) { return(invisible()) } - abort(paste0("Package `", package, "` required for `", fun , "`.\n", - "Please install and try again.")) + abort(glue(" + Package `{package}` required for `{fun}`. + Please install and try again. + ")) } # Return unique columns @@ -83,7 +87,9 @@ uniquecols <- function(df) { #' @export remove_missing <- function(df, na.rm = FALSE, vars = names(df), name = "", finite = FALSE) { - if (!is.logical(na.rm)) abort("`na.rm` must be logical") + if (!is.logical(na.rm)) { + abort("`na.rm` must be logical") + } vars <- intersect(vars, names(df)) if (name != "") name <- paste(" (", name, ")", sep = "") @@ -152,7 +158,9 @@ is_complete <- function(x) { #' should_stop(should_stop("Hi!")) should_stop <- function(expr) { res <- try(print(force(expr)), TRUE) - if (!inherits(res, "try-error")) abort("No error!") + if (!inherits(res, "try-error")) { + abort("No error!") + } invisible() } @@ -189,20 +197,21 @@ gg_dep <- function(version, msg) { .Deprecated() v <- as.package_version(version) cv <- utils::packageVersion("ggplot2") + text <- "{msg} (Defunct; last used in version {version})" # If current major number is greater than last-good major number, or if # current minor number is more than 1 greater than last-good minor number, # give error. if (cv[[1,1]] > v[[1,1]] || cv[[1,2]] > v[[1,2]] + 1) { - abort(paste0(msg, " (Defunct; last used in version ", version, ")")) + abort(glue(text)) # If minor number differs by one, give warning } else if (cv[[1,2]] > v[[1,2]]) { - warn(paste0(msg, " (Deprecated; last used in version ", version, ")")) + warn(glue(text)) # If only subminor number is greater, give message } else if (cv[[1,3]] > v[[1,3]]) { - message(msg, " (Deprecated; last used in version ", version, ")") + message(glue(text)) } invisible() @@ -224,11 +233,11 @@ to_lower_ascii <- function(x) chartr(upper_ascii, lower_ascii, x) to_upper_ascii <- function(x) chartr(lower_ascii, upper_ascii, x) tolower <- function(x) { - abort(paste0('Please use `to_lower_ascii()`, which works fine in all locales.')) + abort("Please use `to_lower_ascii()`, which works fine in all locales.") } toupper <- function(x) { - abort(paste0('Please use `to_upper_ascii()`, which works fine in all locales.')) + abort("Please use `to_upper_ascii()`, which works fine in all locales.") } # Convert a snake_case string to camelCase @@ -378,7 +387,9 @@ is_column_vec <- function(x) { # #> expression(alpha, NA, gamma) # parse_safe <- function(text) { - if (!is.character(text)) abort("`text` must be a character vector") + if (!is.character(text)) { + abort("`text` must be a character vector") + } out <- vector("expression", length(text)) for (i in seq_along(text)) { expr <- parse(text = text[[i]]) From fea9e3d8e07c98d1f288bca06f26301fccb994c6 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 17 Dec 2019 19:49:25 +0100 Subject: [PATCH 4/5] fixing warnings --- R/theme-elements.r | 2 +- tests/testthat/test-conditions.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/theme-elements.r b/R/theme-elements.r index a2eb6b67f7..366d599639 100644 --- a/R/theme-elements.r +++ b/R/theme-elements.r @@ -454,7 +454,7 @@ validate_element <- function(el, elname, element_tree) { abort(glue("Theme element `{elname}` must be a string or numeric vector.")) } else if (eldef$class == "margin") { if (!is.unit(el) && length(el) == 4) - abort(glue("Theme element `ı{elname}` must be a unit vector of length 4.")) + abort(glue("Theme element `{elname}` must be a unit vector of length 4.")) } else if (!inherits(el, eldef$class) && !inherits(el, "element_blank")) { abort(glue("Theme element `{elname}` must be an `{eldef$class}` object.")) } diff --git a/tests/testthat/test-conditions.R b/tests/testthat/test-conditions.R index fb32474a62..a478a884ee 100644 --- a/tests/testthat/test-conditions.R +++ b/tests/testthat/test-conditions.R @@ -11,13 +11,13 @@ get_warning <- function(f) { } test_that("do not use stop()", { - stops <- purrr::map_dfr(list.files("../../R", full.names = TRUE), get_stop, .id = "file") + stops <- do.call(rbind, lapply(list.files("../../R", full.names = TRUE), get_stop)) stop_usage <- nrow(stops) expect_equal(stop_usage, 0) }) test_that("do not use warning()", { - warnings <- purrr::map_dfr(list.files("../../R", full.names = TRUE), get_warning, .id = "file") + warnings <- do.call(rbind, lapply(list.files("../../R", full.names = TRUE), get_warning)) warning_usage <- nrow(warnings) expect_equal(warning_usage, 0) }) From 3df8a46100855e78708170c706300cbd191ef2d8 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 17 Dec 2019 20:16:04 +0100 Subject: [PATCH 5/5] retry stop/warning detection --- tests/testthat/test-conditions.R | 18 ++++++++---------- 1 file changed, 8 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-conditions.R b/tests/testthat/test-conditions.R index a478a884ee..ed3933a6d7 100644 --- a/tests/testthat/test-conditions.R +++ b/tests/testthat/test-conditions.R @@ -1,23 +1,21 @@ context("rlang conditions") -get_stop <- function(f) { +get_n_stop <- function(f) { d <- getParseData(parse(f, keep.source = TRUE)) - d[d$token == "SYMBOL_FUNCTION_CALL" & d$text == "stop", ] + sum(d$token == "SYMBOL_FUNCTION_CALL" & d$text == "stop") } -get_warning <- function(f) { +get_n_warning <- function(f) { d <- getParseData(parse(f, keep.source = TRUE)) - d[d$token == "SYMBOL_FUNCTION_CALL" & d$text == "warning", ] + sum(d$token == "SYMBOL_FUNCTION_CALL" & d$text == "warning") } test_that("do not use stop()", { - stops <- do.call(rbind, lapply(list.files("../../R", full.names = TRUE), get_stop)) - stop_usage <- nrow(stops) - expect_equal(stop_usage, 0) + stops <- vapply(list.files("../../R", full.names = TRUE), get_n_stop, integer(1)) + expect_equal(sum(stops), 0) }) test_that("do not use warning()", { - warnings <- do.call(rbind, lapply(list.files("../../R", full.names = TRUE), get_warning)) - warning_usage <- nrow(warnings) - expect_equal(warning_usage, 0) + warnings <- vapply(list.files("../../R", full.names = TRUE), get_n_warning, integer(1)) + expect_equal(sum(warnings), 0) })