Merge pull request #1379 from tidyverse/f-abort

R/add.R

@@ -41,7 +41,7 @@
 #' @export
 add_row <- function(.data, ..., .before = NULL, .after = NULL) {
   if (inherits(.data, "grouped_df")) {
-    cnd_signal(error_add_rows_to_grouped_df())
+    abort_add_rows_to_grouped_df()
   }
 
   if (!is.data.frame(.data)) {
@@ -57,7 +57,7 @@ add_row <- function(.data, ..., .before = NULL, .after = NULL) {
 
   extra_vars <- setdiff(names(df), names(.data))
   if (has_length(extra_vars)) {
-    cnd_signal(error_incompatible_new_rows(extra_vars))
+    abort_incompatible_new_rows(extra_vars)
   }
 
   pos <- pos_from_before_after(.before, .after, nrow(.data))
@@ -147,7 +147,7 @@ add_column <- function(.data, ..., .before = NULL, .after = NULL,
     if (nrow(df) == 1) {
       df <- df[rep(1L, nrow(.data)), ]
     } else {
-      cnd_signal(error_incompatible_new_cols(nrow(.data), df))
+      abort_incompatible_new_cols(nrow(.data), df)
     }
   }
 
@@ -189,7 +189,7 @@ pos_from_before_after <- function(before, after, len) {
     if (is.null(after)) {
       limit_pos_range(before - 1L, len)
     } else {
-      cnd_signal(error_both_before_after())
+      abort_both_before_after()
     }
   }
 }
@@ -211,45 +211,49 @@ check_names_before_after <- function(j, x) {
 
 check_needs_no_dim <- function(j) {
   if (needs_dim(j)) {
-    cnd_signal(error_dim_column_index(j))
+    abort_dim_column_index(j)
   }
 }
 
 check_names_before_after_character <- function(j, names) {
   pos <- safe_match(j, names)
   if (anyNA(pos)) {
     unknown_names <- j[is.na(pos)]
-    cnd_signal(error_unknown_column_names(unknown_names))
+    abort_unknown_column_names(unknown_names)
   }
   pos
 }
 
 # Errors ------------------------------------------------------------------
 
-error_add_rows_to_grouped_df <- function() {
-  tibble_error("Can't add rows to grouped data frames.")
+msg_unknown_column_names <- function(names) {
+  pluralise_commas("Can't find column(s) ", tick(names), " in `.data`.")
 }
 
-error_incompatible_new_rows <- function(names) {
-  tibble_error(
+abort_add_rows_to_grouped_df <- function() {
+  tibble_abort("Can't add rows to grouped data frames.")
+}
+
+abort_incompatible_new_rows <- function(names) {
+  tibble_abort(
     problems(
       "New rows can't add columns:",
-      cnd_message(error_unknown_column_names(names))
+      msg_unknown_column_names(names)
     ),
     names = names
   )
 }
 
-error_both_before_after <- function() {
-  tibble_error("Can't specify both `.before` and `.after`.")
+abort_both_before_after <- function() {
+  tibble_abort("Can't specify both `.before` and `.after`.")
 }
 
-error_unknown_column_names <- function(j, parent = NULL) {
-  tibble_error(pluralise_commas("Can't find column(s) ", tick(j), " in `.data`."), j = j, parent = parent)
+abort_unknown_column_names <- function(j, parent = NULL) {
+  tibble_abort(pluralise_commas("Can't find column(s) ", tick(j), " in `.data`."), j = j, parent = parent)
 }
 
-error_incompatible_new_cols <- function(n, df) {
-  tibble_error(
+abort_incompatible_new_cols <- function(n, df) {
+  tibble_abort(
     bullets(
       "New columns must be compatible with `.data`:",
       x = paste0(

R/as_tibble.R

@@ -131,7 +131,7 @@ check_valid_cols <- function(x, pos = NULL) {
   is_xd <- which(!map_lgl(x, is_valid_col))
   if (has_length(is_xd)) {
     classes <- map_chr(x[is_xd], friendly_type_of)
-    cnd_signal(error_column_scalar_type(names_x[is_xd], pos[is_xd], classes))
+    abort_column_scalar_type(names_x[is_xd], pos[is_xd], classes)
   }
 
   # 657
@@ -159,7 +159,7 @@ recycle_columns <- function(x, .rows, lengths) {
   if (is_empty(different_len)) return(new_tibble(x, nrow = nrow, subclass = NULL))
 
   if (any(lengths[different_len] != 1)) {
-    cnd_signal(error_incompatible_size(.rows, names(x), lengths, "Requested with `.rows` argument"))
+    abort_incompatible_size(.rows, names(x), lengths, "Requested with `.rows` argument")
   }
 
   if (nrow != 1L) {
@@ -288,7 +288,7 @@ as_tibble.default <- function(x, ...) {
 as_tibble_row <- function(x,
                           .name_repair = c("check_unique", "unique", "universal", "minimal")) {
   if (!vec_is(x)) {
-    cnd_signal(error_as_tibble_row_vector(x))
+    abort_as_tibble_row_vector(x)
   }
 
   names <- vectbl_names2(x, .name_repair = .name_repair)
@@ -312,11 +312,11 @@ check_all_lengths_one <- function(x) {
 
   bad_lengths <- which(sizes != 1)
   if (!is_empty(bad_lengths)) {
-    cnd_signal(error_as_tibble_row_size_one(
+    abort_as_tibble_row_size_one(
       seq_along(x)[bad_lengths],
       names2(x)[bad_lengths],
       sizes[bad_lengths]
-    ))
+    )
   }
 }
 
@@ -348,8 +348,8 @@ matrixToDataFrame <- function(x) {
 
 # Errors ------------------------------------------------------------------
 
-error_column_scalar_type <- function(names, positions, classes) {
-  tibble_error(
+abort_column_scalar_type <- function(names, positions, classes) {
+  tibble_abort(
     problems(
       "All columns in a tibble must be vectors:",
       x = paste0("Column ", name_or_pos(names, positions), " is ", classes)
@@ -358,17 +358,17 @@ error_column_scalar_type <- function(names, positions, classes) {
   )
 }
 
-error_as_tibble_row_vector <- function(x) {
-  tibble_error(paste0(
+abort_as_tibble_row_vector <- function(x) {
+  tibble_abort(paste0(
     "`x` must be a vector in `as_tibble_row()`, not ", class(x)[[1]], "."
   ))
 }
 
-error_as_tibble_row_size_one <- function(j, name, size) {
+abort_as_tibble_row_size_one <- function(j, name, size) {
   desc <- tick(name)
   desc[name == ""] <- paste0("at position ", j[name == ""])
 
-  tibble_error(problems(
+  tibble_abort(problems(
     "All elements must be size one, use `list()` to wrap.",
     paste0("Element ", desc, " is of size ", size, ".")
   ))

R/enframe.R

@@ -21,7 +21,7 @@
 #' enframe(list(one = 1, two = 2:3, three = 4:6))
 enframe <- function(x, name = "name", value = "value") {
   if (is.null(value)) {
-    cnd_signal(error_enframe_value_null())
+    abort_enframe_value_null()
   }
 
   if (is.null(x)) {
@@ -30,7 +30,7 @@ enframe <- function(x, name = "name", value = "value") {
 
   # FIXME: Enable again for data frames, add test
   if (!vec_is(x) || is.data.frame(x)) {
-    cnd_signal(error_enframe_must_be_vector(x))
+    abort_enframe_must_be_vector(x)
   }
 
   if (is.null(name)) {
@@ -77,12 +77,12 @@ deframe <- function(x) {
   vectbl_set_names(value, as.character(name))
 }
 
-error_enframe_value_null <- function() {
-  tibble_error("`value` can't be NULL.")
+abort_enframe_value_null <- function() {
+  tibble_abort("`value` can't be NULL.")
 }
 
-error_enframe_must_be_vector <- function(x) {
-  tibble_error(paste0(
+abort_enframe_must_be_vector <- function(x) {
+  tibble_abort(paste0(
     "The `x` argument to `enframe()` must be a vector, not ", class(x)[[1]], "."
   ))
 }

R/error.R

@@ -18,14 +18,12 @@ tibble_error_class <- function(class) {
 }
 
 # Errors get a class name derived from the name of the calling function
-tibble_abort <- function(x, ..., parent = NULL) {
+tibble_abort <- function(x, ..., call = my_caller_env(), parent = NULL) {
   abort_call <- sys.call(-1)
   fn_name <- as_name(abort_call[[1]])
   class <- tibble_error_class(gsub("^abort_", "", fn_name))
 
-  call <- my_caller_call()
-
-  abort(x, class, ..., call = call, parent = parent)
+  abort(x, class, ..., call = call, parent = parent, use_cli_format = TRUE)
 }
 
 tibble_error <- function(x, ..., parent = NULL) {

R/legacy-compat.R

@@ -5,7 +5,7 @@ tbl_subset_col <- function(x, j, j_arg) {
   j <- vectbl_as_col_location(j, length(x), names(x), j_arg = j_arg, assign = FALSE)
 
   if (anyNA(j)) {
-    cnd_signal(error_na_column_index(which(is.na(j))))
+    abort_na_column_index(which(is.na(j)))
   }
 
   xo <- .subset(x, j)

R/names.R

@@ -25,38 +25,33 @@ repaired_names <- function(name,
 
 # Errors ------------------------------------------------------------------
 
-error_column_names_cannot_be_empty <- function(names, repair_hint, parent = NULL) {
-  tibble_error(invalid_df("must be named", names, use_repair(repair_hint)), names = names, parent = parent)
+abort_column_names_cannot_be_empty <- function(names, repair_hint, details = NULL, parent = NULL, call = my_caller_env()) {
+  tibble_abort(invalid_df("must be named", names, use_repair(repair_hint)), names = names, parent = parent, call = call)
 }
 
-error_column_names_cannot_be_dot_dot <- function(names, repair_hint, parent = NULL) {
-  tibble_error(invalid_df("must not have names of the form ... or ..j", names, use_repair(repair_hint)), names = names, parent = parent)
+abort_column_names_cannot_be_dot_dot <- function(names, repair_hint, parent = NULL, call = my_caller_env()) {
+  tibble_abort(invalid_df("must not have names of the form ... or ..j", names, use_repair(repair_hint)), names = names, parent = parent, call = call)
 }
 
-error_column_names_must_be_unique <- function(names, repair_hint, parent = NULL) {
-  tibble_error(invalid_df("must not be duplicated", names, use_repair(repair_hint), message = "Column name(s)"), names = names, parent = parent)
+abort_column_names_must_be_unique <- function(names, repair_hint, parent = NULL, call = my_caller_env()) {
+  tibble_abort(invalid_df("must not be duplicated", names, use_repair(repair_hint), message = "Column name(s)"), names = names, parent = parent, call = call)
 }
 
 # Subclassing errors ------------------------------------------------------
 
-subclass_name_repair_errors <- function(expr, name, details = NULL, repair_hint = FALSE) {
+subclass_name_repair_errors <- function(expr, name, details = NULL, repair_hint = FALSE, call = my_caller_env()) {
   withCallingHandlers(
     expr,
 
     # FIXME: use cnd$names with vctrs >= 0.3.0
     vctrs_error_names_cannot_be_empty = function(cnd) {
-      cnd <- error_column_names_cannot_be_empty(detect_empty_names(name), parent = cnd, repair_hint = repair_hint)
-      cnd$body <- details
-
-      cnd_signal(cnd)
+      abort_column_names_cannot_be_empty(detect_empty_names(name), details = details, parent = cnd, repair_hint = repair_hint, call = call)
     },
     vctrs_error_names_cannot_be_dot_dot = function(cnd) {
-      cnd <- error_column_names_cannot_be_dot_dot(detect_dot_dot(name), parent = cnd, repair_hint = repair_hint)
-      cnd_signal(cnd)
+      abort_column_names_cannot_be_dot_dot(detect_dot_dot(name), parent = cnd, repair_hint = repair_hint, call = call)
     },
     vctrs_error_names_must_be_unique = function(cnd) {
-      cnd <- error_column_names_must_be_unique(detect_duplicates(name), parent = cnd, repair_hint = repair_hint)
-      cnd_signal(cnd)
+      abort_column_names_must_be_unique(detect_duplicates(name), parent = cnd, repair_hint = repair_hint, call = call)
     }
   )
 }

R/new.R

@@ -44,7 +44,7 @@ new_tibble <- function(x, ..., nrow = NULL, class = NULL, subclass = NULL) {
   x <- unclass(x)
 
   if (!is.list(x)) {
-    cnd_signal(error_new_tibble_must_be_list())
+    abort_new_tibble_must_be_list()
   }
 
   #' The `nrow` argument may be omitted as of tibble 3.1.4.
@@ -54,7 +54,7 @@ new_tibble <- function(x, ..., nrow = NULL, class = NULL, subclass = NULL) {
   #' This takes the place of the "row.names" attribute in a data frame.
   if (!is.null(nrow)) {
     if (!is.numeric(nrow) || length(nrow) != 1 || nrow < 0 || !is_integerish(nrow, 1) || nrow >= 2147483648) {
-      cnd_signal(error_new_tibble_nrow_must_be_nonnegative())
+      abort_new_tibble_nrow_must_be_nonnegative()
     }
     nrow <- as.integer(nrow)
   }
@@ -84,7 +84,7 @@ new_tibble <- function(x, ..., nrow = NULL, class = NULL, subclass = NULL) {
     # Leaving this because creating a named list of length zero seems difficult
     args[["names"]] <- character()
   } else if (is.null(args[["names"]])) {
-    cnd_signal(error_names_must_be_non_null())
+    abort_names_must_be_non_null()
   }
 
   if (is.null(class)) {
@@ -126,19 +126,17 @@ validate_tibble <- function(x) {
   x
 }
 
-cnd_signal_if <- function(x) {
-  if (!is.null(x)) {
-    cnd_signal(x)
+check_minimal_names <- function(x) {
+  names <- names(x)
+
+  if (is.null(names)) {
+    abort_names_must_be_non_null()
   }
-}
 
-check_minimal <- function(name) {
-  cnd_signal_if(cnd_names_non_null(name))
-  cnd_signal_if(cnd_names_non_na(name))
-}
+  if (anyNA(names)) {
+    abort_column_names_cannot_be_empty(which(is.na(names)), repair_hint = FALSE)
+  }
 
-check_minimal_names <- function(x) {
-  check_minimal(names(x))
   invisible(x)
 }
 
@@ -150,7 +148,7 @@ validate_nrow <- function(names, lengths, nrow) {
   # Validate column lengths, don't recycle
   bad_len <- which(lengths != nrow)
   if (has_length(bad_len)) {
-    cnd_signal(error_incompatible_size(nrow, names, lengths, "Requested with `nrow` argument"))
+    abort_incompatible_size(nrow, names, lengths, "Requested with `nrow` argument")
   }
 }
 
@@ -159,10 +157,10 @@ tibble_class_no_data_frame <- c("tbl_df", "tbl")
 
 # Errors ------------------------------------------------------------------
 
-error_new_tibble_must_be_list <- function() {
-  tibble_error("`x` must be a list.")
+abort_new_tibble_must_be_list <- function() {
+  tibble_abort("`x` must be a list.")
 }
 
-error_new_tibble_nrow_must_be_nonnegative <- function() {
-  tibble_error("`nrow` must be a nonnegative whole number smaller than 2^31.")
+abort_new_tibble_nrow_must_be_nonnegative <- function() {
+  tibble_abort("`nrow` must be a nonnegative whole number smaller than 2^31.")
 }

R/rownames.R

@@ -92,11 +92,11 @@ column_to_rownames <- function(.data, var = "rowname") {
   stopifnot(is.data.frame(.data))
 
   if (has_rownames(.data)) {
-    cnd_signal(error_already_has_rownames())
+    abort_already_has_rownames()
   }
 
   if (!has_name(.data, var)) {
-    cnd_signal(error_unknown_column_names(var))
+    abort_unknown_column_names(var)
   }
 
   .data <- as.data.frame(.data)
@@ -119,6 +119,6 @@ raw_rownames <- function(x) {
 
 # Errors ------------------------------------------------------------------
 
-error_already_has_rownames <- function() {
-  tibble_error("`.data` must be a data frame without row names.")
+abort_already_has_rownames <- function() {
+  tibble_abort("`.data` must be a data frame without row names.")
 }