Error consistency (#553)

* Modernise error handling in `str_interp()`

* Make errors more consistent

R/interp.R

@@ -85,7 +85,7 @@ str_interp <- function(string, env = parent.frame()) {
 #'
 #' @noRd
 #' @author Stefan Milton Bache
-interp_placeholders <- function(string) {
+interp_placeholders <- function(string, error_call = caller_env()) {
   # Find starting position of ${} or $[]{} placeholders.
   starts   <- gregexpr("\\$(\\[.*?\\])?\\{", string)[[1]]
 
@@ -101,7 +101,7 @@ interp_placeholders <- function(string) {
   # If there are nested placeholders, each part will not contain a full
   # placeholder in which case we report invalid string interpolation template.
   if (any(!grepl("\\$(\\[.*?\\])?\\{.+\\}", parts)))
-    stop("Invalid template string for interpolation.", call. = FALSE)
+    cli::cli_abort("Invalid template string for interpolation.", call = error_call)
 
   # For each part, find the opening and closing braces.
   opens  <- lapply(strsplit(parts, ""), function(v) which(v == "{"))
@@ -134,9 +134,9 @@ interp_placeholders <- function(string) {
 #'
 #' @noRd
 #' @author Stefan Milton Bache
-eval_interp_matches <- function(matches, env) {
+eval_interp_matches <- function(matches, env, error_call = caller_env()) {
   # Extract expressions from the matches
-  expressions <- extract_expressions(matches)
+  expressions <- extract_expressions(matches, error_call = error_call)
 
   # Evaluate them in the given environment
   values <- lapply(expressions, eval, envir = env,
@@ -161,12 +161,19 @@ eval_interp_matches <- function(matches, env) {
 #'
 #' @noRd
 #' @author Stefan Milton Bache
-extract_expressions <- function(matches) {
+extract_expressions <- function(matches, error_call = caller_env()) {
   # Parse function for text argument as first argument.
+
   parse_text <- function(text) {
-    tryCatch(
+    withCallingHandlers(
       parse(text = text),
-      error = function(e) stop(conditionMessage(e), call. = FALSE)
+      error = function(e) {
+        cli::cli_abort(
+          "Failed to parse input {.str {text}}",
+          parent = e,
+          call = error_call
+        )
+      }
     )
   }
 

R/match.R

@@ -51,7 +51,7 @@
 str_match <- function(string, pattern) {
   check_lengths(string, pattern)
   if (type(pattern) != "regex") {
-    cli::cli_abort("`pattern` must be a regular expression.")
+    cli::cli_abort("{.arg pattern} must be a regular expression.")
   }
 
   stri_match_first_regex(string,
@@ -65,7 +65,7 @@ str_match <- function(string, pattern) {
 str_match_all <- function(string, pattern) {
   check_lengths(string, pattern)
   if (type(pattern) != "regex") {
-    cli::cli_abort("`pattern` must be a regular expression.")
+    cli::cli_abort("{.arg pattern} must be a regular expression.")
   }
 
   stri_match_all_regex(string,

R/modifiers.R

@@ -213,7 +213,7 @@ type.default <- function(x, error_call = caller_env()) {
   }
 
   cli::cli_abort(
-    "`pattern` must be a string, not {.obj_type_friendly {x}}.",
+    "{.arg pattern} must be a string, not {.obj_type_friendly {x}}.",
     call = error_call
   )
 }

R/replace.R

@@ -106,8 +106,8 @@ str_replace_all <- function(string, pattern, replacement) {
 
 
   switch(type(pattern),
-    empty = cli::cli_abort("{.arg pattern} can't be empty."),
-    bound = cli::cli_abort("{.arg pattern} can't be a boundary."),
+    empty = no_empty(),
+    bound = no_boundary(),
     fixed = stri_replace_all_fixed(string, pattern, replacement,
       vectorize_all = vec, opts_fixed = opts(pattern)),
     coll  = stri_replace_all_coll(string, pattern, replacement,
@@ -217,13 +217,13 @@ str_transform_all <- function(string, pattern, replacement, error_call = caller_
 
   if (!is.character(new_flat)) {
     cli::cli_abort(
-      "Function {.arg replacement} must return a character vector, not {.obj_type_friendly {new_flat}}.",
+      "{.arg replacement} function must return a character vector, not {.obj_type_friendly {new_flat}}.",
       call = error_call
     )
   }
   if (length(new_flat) != length(old_flat)) {
     cli::cli_abort(
-      "Function {.arg replacement} must return a vector the same length as the input ({length(old_flat)}), not length {length(new_flat)}.",
+      "{.arg replacement} function must return a vector the same length as the input ({length(old_flat)}), not length {length(new_flat)}.",
       call = error_call
     )
   }

tests/testthat/_snaps/interp.md

@@ -0,0 +1,33 @@
+# str_interp fails when encountering nested placeholders
+
+    Code
+      str_interp("${${msg}}")
+    Condition
+      Error in `str_interp()`:
+      ! Invalid template string for interpolation.
+    Code
+      str_interp("$[.2f]{${msg}}")
+    Condition
+      Error in `str_interp()`:
+      ! Invalid template string for interpolation.
+
+# str_interp fails when input is not a character string
+
+    Code
+      str_interp(3L)
+    Condition
+      Error in `str_interp()`:
+      ! `string` must be a character vector, not the number 3.
+
+# str_interp wraps parsing errors
+
+    Code
+      str_interp("This is a ${1 +}")
+    Condition
+      Error in `str_interp()`:
+      ! Failed to parse input "1 +"
+      Caused by error in `parse()`:
+      ! <text>:2:0: unexpected end of input
+      1: 1 +
+         ^
+

tests/testthat/_snaps/replace.md

@@ -22,7 +22,7 @@
       str_replace_all("x", "", "")
     Condition
       Error in `str_replace_all()`:
-      ! `pattern` can't be empty.
+      ! `pattern` can't be the empty string (`""`).
     Code
       str_replace_all("x", boundary("word"), "")
     Condition
@@ -46,12 +46,12 @@
       str_replace_all("x", "x", ~1)
     Condition
       Error in `str_replace_all()`:
-      ! Function `replacement` must return a character vector, not a number.
+      ! `replacement` function must return a character vector, not a number.
     Code
       str_replace_all("x", "x", ~ c("a", "b"))
     Condition
       Error in `str_replace_all()`:
-      ! Function `replacement` must return a vector the same length as the input (1), not length 2.
+      ! `replacement` function must return a vector the same length as the input (1), not length 2.
 
 # backrefs are correctly translated
 

tests/testthat/test-interp.R

@@ -52,19 +52,19 @@ test_that("str_interp fails when encountering nested placeholders", {
   msg  <- "This will never see the light of day"
   num  <- 1.2345
 
-  expect_error(
-    str_interp("${${msg}}"),
-    "Invalid template string for interpolation"
-  )
-
-  expect_error(
-    str_interp("$[.2f]{${msg}}"),
-    "Invalid template string for interpolation"
-  )
+  expect_snapshot(error = TRUE, {
+    str_interp("${${msg}}")
+    str_interp("$[.2f]{${msg}}")
+  })
 })
 
 test_that("str_interp fails when input is not a character string", {
-  expect_error(str_interp(3L))
+  expect_snapshot(str_interp(3L), error = TRUE)
+})
+
+test_that("str_interp wraps parsing errors", {
+  expect_snapshot(str_interp("This is a ${1 +}"), error = TRUE)
+
 })
 
 test_that("str_interp formats list independetly of other placeholders", {