Mention index calls in error messages

Part of #1406

NEWS.md

@@ -1,5 +1,7 @@
 # rlang (development version)
 
+* Error messages now mention indexed calls like `foo$bar()`.
+
 * New `env_coalesce()` function to copy bindings from one environment
   to another. Unlike approaches based on looping with `[[<-`,
   `env_coalesce()` preserves active and lazy bindings.

R/call.R

@@ -900,6 +900,48 @@ is_call_simple <- function(x, ns = NULL) {
   namespaced || is_symbol(head)
 }
 
+is_call_index <- function(x, ns = NULL) {
+  check_required(x)
+
+  if (!is_call(x)) {
+    return(FALSE)
+  }
+
+  out <- FALSE
+
+  while (is_call(fn <- x[[1]])) {
+    if (!is_call(fn, c("$", "@", "[", "[["))) {
+      return(FALSE)
+    }
+
+    if (!every(fn[-1], is_arg_index, ns)) {
+      return(FALSE)
+    }
+
+    out <- TRUE
+    x <- fn
+  }
+
+  out
+}
+
+is_arg_index <- function(arg, ns) {
+  if (!is_call(arg)) {
+    return(TRUE)
+  }
+
+  namespaced <- is_call(arg, c("::", ":::"))
+  if (namespaced) {
+    if (!is_null(ns) && !identical(namespaced, ns)) {
+      return(FALSE)
+    } else {
+      return(TRUE)
+    }
+  }
+
+  is_call_simple(arg)
+}
+
 #' Extract arguments from a call
 #'
 #' @inheritParams call_name

R/cnd-abort.R

@@ -1125,7 +1125,11 @@ error_call_as_string <- function(call) {
   }
 
   if (!is_call_simple(call)) {
-    return(NULL)
+    if (is_expression(call) && is_call_index(call)) {
+      return(as_label(call[1]))
+    } else {
+      return(NULL)
+    }
   }
 
   # Remove namespace for now to simplify conversion

tests/testthat/_snaps/cnd-message.md

@@ -101,7 +101,7 @@
     Code
       writeLines(cnd_message_format_prefixed(err2))
     Output
-      Error:
+      Error in `foo$bar()`:
       ! msg
     Code
       writeLines(cnd_message_format_prefixed(err3))

tests/testthat/test-call.R

@@ -592,3 +592,14 @@ test_that("call_name() and call_ns() detect `::` calls (#670)", {
   expect_null(call_ns(quote(foo::bar)))
   expect_null(call_ns(quote(foo:::bar)))
 })
+
+test_that("is_call_index() works", {
+  expect_true(is_call_index(quote(a$b(...))))
+  expect_true(is_call_index(quote(a@b$c[[d]](...))))
+  expect_true(is_call_index(quote(a@b$c[[d]](...))))
+  expect_true(is_call_index(quote(foo::a$b(...))))
+
+  expect_false(is_call_index(quote(a@b$c[[d]])))
+  expect_false(is_call_index(quote(1 + a@b$c[[d]])))
+  expect_false(is_call_index(quote((a@b$c[[d]])())))
+})

tests/testthat/test-cnd-abort.R

@@ -363,11 +363,14 @@ test_that("NSE doesn't interfere with error call contexts", {
 })
 
 test_that("error_call() requires a symbol in function position", {
-  expect_null(format_error_call(quote(foo$bar())))
   expect_null(format_error_call(quote((function() NULL)())))
   expect_null(format_error_call(call2(function() NULL)))
 })
 
+test_that("error_call() preserves index calls", {
+  expect_equal(format_error_call(quote(foo$bar(...))), "`foo$bar()`")
+})
+
 test_that("error_call() preserves `if` (r-lib/testthat#1429)", {
   call <- quote(if (foobar) TRUE else FALSE)