Handle parse errors more accurately

R/source.R

@@ -11,39 +11,10 @@ source_many <- function(files, encoding = "UTF-8", envir = parent.frame()) {
   for (file in files) {
     try_fetch(
       source_one(file, encoding, envir = envir),
-      error = function(cnd) {
-        path <- file.path(basename(dirname(file)), basename(file))
-        is_parse_error <- is_call(cnd$call, "parse")
-
-        if (is_parse_error) {
-          # Tweak base message to be shorter and add link to src location.
-          location <- conditionMessage(cnd)
-          # extract :<line>:<col> in base message.
-          line_col <- regmatches(location, m = regexpr("\\:\\d+\\:\\d+", location))
-          if (length(line_col) > 0) {
-            # Tweak parent message.
-            path_show <- paste0(path, line_col)
-            # tweak parse() message to include an hyperlink.
-            # Replace full path by relative path + hyperlink
-            path_hyperlink <- cli::format_inline(paste0("At {.file ", path_show, "}:"))
-
-            cnd$message <- sub(
-              paste0("^.*", path_show, "\\:"),
-              path_hyperlink,
-              cnd$message
-            )
-            # only need for basename in pkgload message, since hyperlink
-            # is now included in parent message
-            msg <- paste0("Failed to load {.val {basename(path)}}")
-
-          }
-        } else {
-          msg <- paste0("Failed to load {.file {path}}")
-        }
-        cli::cli_abort(msg, parent = cnd, call = quote(load_all()))
-      }
+      error = function(cnd) handle_source_error(cnd, file)
     )
   }
+
   invisible()
 }
 
@@ -52,15 +23,49 @@ source_one <- function(file, encoding, envir = parent.frame()) {
   stopifnot(is.environment(envir))
 
   lines <- read_lines_enc(file, file_encoding = encoding)
-  srcfile <- srcfilecopy(file, lines, file.info(file)[1, "mtime"],
-    isFile = TRUE)
-  exprs <- parse(text = lines, n = -1, srcfile = srcfile)
+  srcfile <- srcfilecopy(file, lines, file.info(file)[1, "mtime"], isFile = TRUE)
 
-  n <- length(exprs)
-  if (n == 0L) return(invisible())
+  withCallingHandlers(
+    exprs <- parse(text = lines, n = -1, srcfile = srcfile),
+    error = function(cnd) handle_parse_error(cnd, file)
+  )
 
-  for (i in seq_len(n)) {
-    eval(exprs[i], envir)
+  for (expr in exprs) {
+    eval(expr, envir)
   }
+
   invisible()
 }
+
+handle_source_error <- function(cnd, file) {
+  path <- file.path(basename(dirname(file)), basename(file))
+  msg <- paste0("Failed to load {.file {path}}")
+  cli::cli_abort(msg, parent = cnd, call = quote(load_all()))
+}
+
+handle_parse_error <- function(cnd, file) {
+  path <- file.path(basename(dirname(file)), basename(file))
+
+  # Tweak base message to be shorter and add link to src location.
+  msg <- conditionMessage(cnd)
+
+  # Extract :<line>:<col> in base message.
+  location <- regmatches(msg, m = regexpr("\\:\\d+\\:\\d+", msg))
+
+  if (length(location) == 0) {
+    return(zap())
+  }
+
+  suffixed_path <- paste0(path, location)
+
+  # Tweak parse() message to include an hyperlink.
+  # Replace full path by relative path + hyperlink
+  path_hyperlink <- cli::format_inline(paste0("At {.file ", suffixed_path, "}:"))
+  msg <- sub(
+    paste0("^.*", suffixed_path, "\\:"),
+    path_hyperlink,
+    msg
+  )
+
+  abort(msg, call = conditionCall(cnd))
+}

tests/testthat/_snaps/source.md

@@ -4,7 +4,7 @@
       source_many(test_path("testSource", c("a.R", "b.R")))
     Condition
       Error in `load_all()`:
-      ! Failed to load "b.R"
+      ! Failed to load 'testSource/b.R'
       Caused by error in `parse()`:
       ! At 'testSource/b.R:2:0': unexpected end of input
       1: b <-