From 8c5ddaa726bdbfd67c3bec40e3303f680a773184 Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Tue, 7 Jun 2022 14:17:00 +0200
Subject: [PATCH] Mention index calls in error messages

Part of #1406
---
 NEWS.md                              |  2 ++
 R/call.R                             | 42 ++++++++++++++++++++++++++++
 R/cnd-abort.R                        |  6 +++-
 tests/testthat/_snaps/cnd-message.md |  2 +-
 tests/testthat/test-call.R           | 11 ++++++++
 tests/testthat/test-cnd-abort.R      |  5 +++-
 6 files changed, 65 insertions(+), 3 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 6cf76ebbe7..1f9ef99dd6 100644
--- a/NEWS.md
+++ b/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.
diff --git a/R/call.R b/R/call.R
index 383aac6282..b96693fe11 100644
--- a/R/call.R
+++ b/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
diff --git a/R/cnd-abort.R b/R/cnd-abort.R
index a821f82599..f680761676 100644
--- a/R/cnd-abort.R
+++ b/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
diff --git a/tests/testthat/_snaps/cnd-message.md b/tests/testthat/_snaps/cnd-message.md
index 89889aa173..f16d3dc4dc 100644
--- a/tests/testthat/_snaps/cnd-message.md
+++ b/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))
diff --git a/tests/testthat/test-call.R b/tests/testthat/test-call.R
index d40a97307d..3576176b4d 100644
--- a/tests/testthat/test-call.R
+++ b/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]])())))
+})
diff --git a/tests/testthat/test-cnd-abort.R b/tests/testthat/test-cnd-abort.R
index 23db12a612..b8100930dc 100644
--- a/tests/testthat/test-cnd-abort.R
+++ b/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)