Scale call check (#5443)

* Fix #5436 * Add tests
tidyverse · Oct 2, 2023 · fa26a55 · fa26a55
1 parent ad33741
commit fa26a55
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 2 deletions.
diff --git a/R/scale-continuous.R b/R/scale-continuous.R
@@ -85,7 +85,7 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(),
                                guide = waiver(), position = "bottom",
                                sec.axis = waiver()) {
   call <- caller_call()
-  if (is.null(call) || !startsWith(as.character(call[[1]]), "scale_")) {
+  if (is.null(call) || !any(startsWith(as.character(call[[1]]), "scale_"))) {
     call <- current_call()
   }
   sc <- continuous_scale(
@@ -111,7 +111,7 @@ scale_y_continuous <- function(name = waiver(), breaks = waiver(),
                                guide = waiver(), position = "left",
                                sec.axis = waiver()) {
   call <- caller_call()
-  if (is.null(call) || !startsWith(as.character(call[[1]]), "scale_")) {
+  if (is.null(call) || !any(startsWith(as.character(call[[1]]), "scale_"))) {
     call <- current_call()
   }
   sc <- continuous_scale(

diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R
@@ -648,6 +648,36 @@ test_that("scale functions accurately report their calls", {
   expect_equal(calls, construct)
 })
 
+test_that("scale call is found accurately", {
+
+  call_template <- quote(scale_x_continuous(trans = "log10"))
+
+  sc <- do.call("scale_x_continuous", list(trans = "log10"))
+  expect_equal(sc$call, call_template)
+
+  sc <- inject(scale_x_continuous(!!!list(trans = "log10")))
+  expect_equal(sc$call, call_template)
+
+  sc <- exec("scale_x_continuous", trans = "log10")
+  expect_equal(sc$call, call_template)
+
+  foo <- function() scale_x_continuous(trans = "log10")
+  expect_equal(foo()$call, call_template)
+
+  env <- new_environment()
+  env$bar <- function() scale_x_continuous(trans = "log10")
+  expect_equal(env$bar()$call, call_template)
+
+  # Now should recognise the outer function
+  scale_x_new <- function() {
+    scale_x_continuous(trans = "log10")
+  }
+  expect_equal(
+    scale_x_new()$call,
+    quote(scale_x_new())
+  )
+})
+
 test_that("training incorrectly appropriately communicates the offenders", {
 
   sc <- scale_colour_viridis_d()