Scale call check (#5443)

* Fix #5436

* Add tests

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(

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()