From bac8ff04b19eb25677702c541d687450b699a44c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 28 Oct 2024 20:05:14 +0100 Subject: [PATCH 1/4] error on circular parents --- R/theme-elements.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/theme-elements.R b/R/theme-elements.R index fb3341bf49..b162cd85c7 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -414,6 +414,16 @@ register_theme_elements <- function(..., element_tree = NULL, complete = TRUE) { t <- theme(..., complete = complete) ggplot_global$theme_default <- ggplot_global$theme_default %+replace% t + # Check element tree, prevent elements from being their own parent (#6162) + bad_parent <- unlist(Map( + function(name, el) any(name %in% el$inherit), + name = names(element_tree), el = element_tree + )) + if (any(bad_parent)) { + bad_parent <- names(element_tree)[bad_parent] + cli::cli_abort("Invalid parent: {.and {.val {bad_parent}}}.") + } + # Merge element trees ggplot_global$element_tree <- defaults(element_tree, ggplot_global$element_tree) From 88cf661b1b5993d934c23890d0b25ed13cfe2432 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 29 Oct 2024 09:48:42 +0100 Subject: [PATCH 2/4] more elaborate checks on element tree --- R/theme-elements.R | 47 +++++++++++++++++++++++++++++++++++++--------- 1 file changed, 38 insertions(+), 9 deletions(-) diff --git a/R/theme-elements.R b/R/theme-elements.R index b162cd85c7..cdfd0cbe8e 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -414,15 +414,7 @@ register_theme_elements <- function(..., element_tree = NULL, complete = TRUE) { t <- theme(..., complete = complete) ggplot_global$theme_default <- ggplot_global$theme_default %+replace% t - # Check element tree, prevent elements from being their own parent (#6162) - bad_parent <- unlist(Map( - function(name, el) any(name %in% el$inherit), - name = names(element_tree), el = element_tree - )) - if (any(bad_parent)) { - bad_parent <- names(element_tree)[bad_parent] - cli::cli_abort("Invalid parent: {.and {.val {bad_parent}}}.") - } + check_element_tree(element_tree) # Merge element trees ggplot_global$element_tree <- defaults(element_tree, ggplot_global$element_tree) @@ -469,6 +461,43 @@ get_element_tree <- function() { ggplot_global$element_tree } +check_element_tree <- function(x, arg = caller_arg(x), call = caller_env()) { + check_object(x, is_bare_list, "a bare {.cls list}", arg = arg, call = call) + if (length(x) < 1) { + return(invisible(NULL)) + } + + if (!is_named(x)) { + cli::cli_abort("{.arg {arg}} must have names.", call = call) + } + + # All elements should be constructed with `el_def()` + fields <- names(el_def()) + bad_fields <- !vapply(x, function(el) all(fields %in% names(el)), logical(1)) + if (any(bad_fields)) { + bad_fields <- names(x)[bad_fields] + cli::cli_abort( + c("{.arg {arg}} must have elements constructed with {.fn el_def}.", + i = "Invalid structure: {.and {.val {bad_fields}}}"), + call = call + ) + } + + # Check element tree, prevent elements from being their own parent (#6162) + bad_parent <- unlist(Map( + function(name, el) any(name %in% el$inherit), + name = names(x), el = x + )) + if (any(bad_parent)) { + bad_parent <- names(x)[bad_parent] + cli::cli_abort( + "Invalid parent in {.arg {arg}}: {.and {.val {bad_parent}}}.", + call = call + ) + } + invisible(NULL) +} + #' @rdname register_theme_elements #' @details #' The function `el_def()` is used to define new or modified element types and From 2d82b319ef03d964f2db4949d7c32f119792638a Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 29 Oct 2024 09:48:54 +0100 Subject: [PATCH 3/4] add test --- tests/testthat/_snaps/theme.md | 13 +++++++++++++ tests/testthat/test-theme.R | 11 +++++++++++ 2 files changed, 24 insertions(+) diff --git a/tests/testthat/_snaps/theme.md b/tests/testthat/_snaps/theme.md index 259a887c1a..92afc1132d 100644 --- a/tests/testthat/_snaps/theme.md +++ b/tests/testthat/_snaps/theme.md @@ -40,6 +40,19 @@ The `blablabla` theme element must be a object. +--- + + `element_tree` must have names. + +--- + + `element_tree` must have elements constructed with `el_def()`. + i Invalid structure: "foo" + +--- + + Invalid parent in `element_tree`: "foo". + # Theme elements are checked during build `plot.title.position` must be one of "panel" or "plot", not "test". diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 36ad577c65..8941176549 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -312,6 +312,17 @@ test_that("element tree can be modified", { p1 <- ggplot() + theme(blablabla = element_line()) expect_snapshot_error(ggplotGrob(p1)) + # Expect errors for invalid element trees + expect_snapshot_error( + register_theme_elements(element_tree = list(el_def("rect"), el_def("line"))) + ) + expect_snapshot_error( + register_theme_elements(element_tree = list(foo = "bar")) + ) + expect_snapshot_error( + register_theme_elements(element_tree = list(foo = el_def(inherit = "foo"))) + ) + # inheritance and final calculation of novel element works final_theme <- ggplot2:::plot_theme(p, theme_gray()) e1 <- calc_element("blablabla", final_theme) From 6f4122e96821c8e21d1c32b8e7fa8ea0bf1b6c2d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 29 Oct 2024 09:50:13 +0100 Subject: [PATCH 4/4] add news bullet --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 540e662f0c..b103130d19 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # ggplot2 (development version) +* Stricter check on `register_theme_elements(element_tree)` (@teunbrand, #6162) * Fixed bug where binned scales wouldn't simultaneously accept transformations and function-limits (@teunbrand, #6144). * Fixed bug where the `ggplot2::`-prefix did not work with `stage()`