From 331f106b072543b77d474411155ea1a0f6011b75 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Tue, 27 Apr 2021 13:50:00 +0200 Subject: [PATCH 1/3] convert param to environment --- NEWS.md | 2 ++ R/labeller.r | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index e195f78613..c2f6144ac8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* Make sure `label_bquote()` has access to the calling environment when + evaluating the labels (@thomasp85, #4141) * Fix bug in `annotate_logticks()` that would cause an error when used together with `coord_flip()` (@thomasp85, #3954) diff --git a/R/labeller.r b/R/labeller.r index 099a2d961d..c4f93f0da8 100644 --- a/R/labeller.r +++ b/R/labeller.r @@ -205,6 +205,8 @@ label_bquote <- function(rows = NULL, cols = NULL, rows_quoted <- substitute(rows) has_warned <- FALSE + call_env <- env_parent() + fun <- function(labels) { quoted <- resolve_labeller(rows_quoted, cols_quoted, labels) if (is.null(quoted)) { @@ -225,7 +227,7 @@ label_bquote <- function(rows = NULL, cols = NULL, } params$x <- params[[1]] } - + params <- as_environment(params, call_env) eval(substitute(bquote(expr, params), list(expr = quoted))) } list(do.call("Map", c(list(f = evaluate), labels))) From a8e2120c9ac8664300547430a52852fcd24579b7 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Wed, 28 Apr 2021 11:58:53 +0200 Subject: [PATCH 2/3] add test --- tests/testthat/test-labellers.R | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 tests/testthat/test-labellers.R diff --git a/tests/testthat/test-labellers.R b/tests/testthat/test-labellers.R new file mode 100644 index 0000000000..30f1a4be94 --- /dev/null +++ b/tests/testthat/test-labellers.R @@ -0,0 +1,9 @@ +context("Labellers") + +test_that("label_bquote has access to functions in the calling environment", { + labels <- data.frame(lab = letters[1:2]) + attr(labels, "facet") <- "wrap" + labeller <- label_bquote(rows = .(paste0(lab, ":"))) + labels_calc <- labeller(labels) + expect_equal(labels_calc[[1]]$a, "a:") +}) From e006e92605bd93896cf3b044f2dbb59e186509d2 Mon Sep 17 00:00:00 2001 From: Thomas Lin Pedersen Date: Thu, 29 Apr 2021 10:00:31 +0200 Subject: [PATCH 3/3] Fix test for old R versions --- tests/testthat/test-labellers.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-labellers.R b/tests/testthat/test-labellers.R index 30f1a4be94..5900e31e4e 100644 --- a/tests/testthat/test-labellers.R +++ b/tests/testthat/test-labellers.R @@ -5,5 +5,5 @@ test_that("label_bquote has access to functions in the calling environment", { attr(labels, "facet") <- "wrap" labeller <- label_bquote(rows = .(paste0(lab, ":"))) labels_calc <- labeller(labels) - expect_equal(labels_calc[[1]]$a, "a:") + expect_equal(labels_calc[[1]][[1]], "a:") })