Skip to content

Commit a4264bc

Browse files
authored
Checks for register_theme_element(element_tree) (#6169)
* error on circular parents * more elaborate checks on element tree * add test * add news bullet
1 parent a62895a commit a4264bc

File tree

4 files changed

+64
-0
lines changed

4 files changed

+64
-0
lines changed

NEWS.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -262,6 +262,7 @@
262262
* Added `panel.widths` and `panel.heights` to `theme()` (#5338, @teunbrand).
263263
* Standardised the calculation of `width`, which are now implemented as
264264
aesthetics (@teunbrand, #2800).
265+
* Stricter check on `register_theme_elements(element_tree)` (@teunbrand, #6162)
265266

266267
# ggplot2 3.5.1
267268

R/theme-elements.R

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -415,6 +415,8 @@ register_theme_elements <- function(..., element_tree = NULL, complete = TRUE) {
415415
t <- theme(..., complete = complete)
416416
ggplot_global$theme_default <- ggplot_global$theme_default %+replace% t
417417

418+
check_element_tree(element_tree)
419+
418420
# Merge element trees
419421
ggplot_global$element_tree <- defaults(element_tree, ggplot_global$element_tree)
420422

@@ -460,6 +462,43 @@ get_element_tree <- function() {
460462
ggplot_global$element_tree
461463
}
462464

465+
check_element_tree <- function(x, arg = caller_arg(x), call = caller_env()) {
466+
check_object(x, is_bare_list, "a bare {.cls list}", arg = arg, call = call)
467+
if (length(x) < 1) {
468+
return(invisible(NULL))
469+
}
470+
471+
if (!is_named(x)) {
472+
cli::cli_abort("{.arg {arg}} must have names.", call = call)
473+
}
474+
475+
# All elements should be constructed with `el_def()`
476+
fields <- names(el_def())
477+
bad_fields <- !vapply(x, function(el) all(fields %in% names(el)), logical(1))
478+
if (any(bad_fields)) {
479+
bad_fields <- names(x)[bad_fields]
480+
cli::cli_abort(
481+
c("{.arg {arg}} must have elements constructed with {.fn el_def}.",
482+
i = "Invalid structure: {.and {.val {bad_fields}}}"),
483+
call = call
484+
)
485+
}
486+
487+
# Check element tree, prevent elements from being their own parent (#6162)
488+
bad_parent <- unlist(Map(
489+
function(name, el) any(name %in% el$inherit),
490+
name = names(x), el = x
491+
))
492+
if (any(bad_parent)) {
493+
bad_parent <- names(x)[bad_parent]
494+
cli::cli_abort(
495+
"Invalid parent in {.arg {arg}}: {.and {.val {bad_parent}}}.",
496+
call = call
497+
)
498+
}
499+
invisible(NULL)
500+
}
501+
463502
#' @rdname register_theme_elements
464503
#' @details
465504
#' The function `el_def()` is used to define new or modified element types and

tests/testthat/_snaps/theme.md

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -56,6 +56,19 @@
5656

5757
The `blablabla` theme element must be a <element_text> object.
5858

59+
---
60+
61+
`element_tree` must have names.
62+
63+
---
64+
65+
`element_tree` must have elements constructed with `el_def()`.
66+
i Invalid structure: "foo"
67+
68+
---
69+
70+
Invalid parent in `element_tree`: "foo".
71+
5972
# elements can be merged
6073

6174
Code

tests/testthat/test-theme.R

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -312,6 +312,17 @@ test_that("element tree can be modified", {
312312
p1 <- ggplot() + theme(blablabla = element_line())
313313
expect_snapshot_error(ggplotGrob(p1))
314314

315+
# Expect errors for invalid element trees
316+
expect_snapshot_error(
317+
register_theme_elements(element_tree = list(el_def("rect"), el_def("line")))
318+
)
319+
expect_snapshot_error(
320+
register_theme_elements(element_tree = list(foo = "bar"))
321+
)
322+
expect_snapshot_error(
323+
register_theme_elements(element_tree = list(foo = el_def(inherit = "foo")))
324+
)
325+
315326
# inheritance and final calculation of novel element works
316327
final_theme <- ggplot2:::plot_theme(p, theme_gray())
317328
e1 <- calc_element("blablabla", final_theme)

0 commit comments

Comments
 (0)