fix inherits() issues

Author: teunbrand

R/guide-.R

@@ -379,7 +379,7 @@ Guide <- ggproto(
     if (!is.theme_element(elements)) {
       elements <- elements$ticks
     }
-    if (!inherits(elements, "element_line")) {
+    if (!S7::S7_inherits(elements, element_line)) {
       return(zeroGrob())
     }
 

R/guide-axis-logticks.R

@@ -119,7 +119,7 @@ guide_axis_logticks <- function(
     allow_null = TRUE
   )
   check_bool(expanded)
-  check_inherits(short.theme, c("element_blank", "element_line"))
+  check_inherits(short.theme, c("ggplot2::element_blank", "ggplot2::element_line"))
 
   new_guide(
     available_aes  = c("x", "y"),

R/guide-axis-theta.R

@@ -183,7 +183,7 @@ GuideAxisTheta <- ggproto(
 
   build_labels = function(key, elements, params) {
 
-    if (inherits(elements$text, "element_blank")) {
+    if (S7::S7_inherits(elements$text, element_blank)) {
       return(zeroGrob())
     }
 
@@ -267,7 +267,7 @@ GuideAxisTheta <- ggproto(
     key <- params$key
     key <- vec_slice(key, !is.na(key$.label) & nzchar(key$.label))
     labels <- validate_labels(key$.label)
-    if (length(labels) == 0 || inherits(elements$text, "element_blank")) {
+    if (length(labels) == 0 || S7::S7_inherits(elements$text, element_blank)) {
       return(list(offset = offset))
     }
 
@@ -364,7 +364,7 @@ GuideAxisTheta <- ggproto(
 
 theta_tickmarks <- function(key, element, length, offset = NULL) {
   n_breaks <- nrow(key)
-  if (n_breaks < 1 || inherits(element, "element_blank")) {
+  if (n_breaks < 1 || S7::S7_inherits(element, element_blank)) {
     return(zeroGrob())
   }
 

R/guide-axis.R

@@ -259,10 +259,10 @@ GuideAxis <- ggproto(
   override_elements = function(params, elements, theme) {
     elements$text <-
       label_angle_heuristic(elements$text, params$position, params$angle)
-    if (inherits(elements$ticks, "element_blank")) {
+    if (S7::S7_inherits(elements$ticks, element_blank)) {
       elements$major_length <- unit(0, "cm")
     }
-    if (inherits(elements$minor, "element_blank") || isFALSE(params$minor.ticks)) {
+    if (S7::S7_inherits(elements$minor, element_blank) || isFALSE(params$minor.ticks)) {
       elements$minor_length <- unit(0, "cm")
     }
     return(elements)
@@ -379,7 +379,7 @@ GuideAxis <- ggproto(
     # Ticks
     major_cm <- convertUnit(elements$major_length, "cm", valueOnly = TRUE)
     range <- range(0, major_cm)
-    if (params$minor.ticks && !inherits(elements$minor, "element_blank")) {
+    if (params$minor.ticks && !S7::S7_inherits(elements$minor, element_blank)) {
       minor_cm <- convertUnit(elements$minor_length, "cm", valueOnly = TRUE)
       range <- range(range, minor_cm)
     }
@@ -590,7 +590,7 @@ axis_label_priority_between <- function(x, y) {
 #'   overridden from the user- or theme-supplied element.
 #' @noRd
 label_angle_heuristic <- function(element, position, angle) {
-  if (!inherits(element, "element_text")
+  if (!S7::S7_inherits(element, element_text)
       || is.null(position)
       || is.null(angle %|W|% NULL)) {
     return(element)

R/plot-build.R

@@ -342,7 +342,7 @@ table_add_tag <- function(table, label, theme) {
     return(table)
   }
   element <- calc_element("plot.tag", theme)
-  if (inherits(element, "element_blank")) {
+  if (S7::S7_inherits(element, element_blank)) {
     return(table)
   }
 

R/theme-elements.R

@@ -861,8 +861,11 @@ check_element <- function(el, elname, element_tree, call = caller_env()) {
   if ("margin" %in% class) {
     if (!is.unit(el) && length(el) == 4)
       cli::cli_abort("The {.var {elname}} theme element must be a {.cls unit} vector of length 4.", call = call)
-  } else if (!inherits(el, class) && !inherits(el, "element_blank")) {
-    cli::cli_abort("The {.var {elname}} theme element must be a {.cls {eldef$class}} object.", call = call)
+  } else if (!inherits(el, class) && !S7::S7_inherits(el, element_blank)) {
+    if (inherits(class, "S7_class")) {
+      class <- class@name
+    }
+    cli::cli_abort("The {.var {elname}} theme element must be a {.cls {class}} object.", call = call)
   }
   invisible()
 }

R/theme.R

@@ -719,7 +719,7 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE,
 
   # If result is element_blank, we skip it if `skip_blank` is `TRUE`,
   # and otherwise we don't inherit anything from parents
-  if (inherits(el_out, "element_blank")) {
+  if (S7::S7_inherits(el_out, element_blank)) {
     if (isTRUE(skip_blank)) {
       el_out <- NULL
     } else {
@@ -733,9 +733,17 @@ calc_element <- function(element, theme, verbose = FALSE, skip_blank = FALSE,
 
   # If the element is defined (and not just inherited), check that
   # it is of the class specified in element_tree
-  if (!is.null(el_out) &&
-      !inherits(el_out, element_tree[[element]]$class)) {
-    cli::cli_abort("Theme element {.var {element}} must have class {.cls {ggplot_global$element_tree[[element]]$class}}.", call = call)
+  if (!is.null(el_out)) {
+    class <- element_tree[[element]]$class
+    if (inherits(class, "S7_class")) {
+      if (!S7::S7_inherits(el_out, class)) {
+        cli::cli_abort("Theme element {.var {element}} must have class {.cls {class@name}}.", call = call)
+      }
+    } else {
+      if (!inherits(el_out, class)) {
+        cli::cli_abort("Theme element {.var {element}} must have class {.cls {ggplot_global$element_tree[[element]]$class}}.", call = call)
+      }
+    }
   }
 
   # Get the names of parents from the inheritance tree

tests/testthat/test-theme.R

@@ -21,8 +21,8 @@ test_that("modifying theme element properties with + operator works", {
   # Make sure the theme class didn't change or get dropped
   expect_true(is.theme(t))
   # Make sure the element class didn't change or get dropped
-  expect_true(inherits(t$axis.title.x, "element"))
-  expect_true(inherits(t$axis.title.x, "element_text"))
+  expect_s3_class(t$axis.title.x, "ggplot2::element")
+  expect_s3_class(t$axis.title.x, "ggplot2::element_text")
 
   # Modifying an intermediate node works
   t <- theme_grey() + theme(axis.title = element_text(colour = 'red'))
@@ -346,7 +346,7 @@ test_that("element tree can be modified", {
 test_that("all elements in complete themes have inherit.blank=TRUE", {
   inherit_blanks <- function(theme) {
     all(vapply(theme, function(el) {
-      if (inherits(el, "element") && !inherits(el, "element_blank")) {
+      if (inherits(el, "element") && !S7::S7_inherits(el, element_blank)) {
         el$inherit.blank
       } else {
         TRUE
@@ -642,15 +642,15 @@ test_that("complete_theme completes a theme", {
 
   # Missing elements are filled in if default theme is incomplete
   new <- complete_theme(default = theme())
-  expect_s3_class(new$axis.line, "element_blank")
+  expect_s3_class(new$axis.line, "ggplot2::element_blank")
 
   # Registered elements are included
   register_theme_elements(
     test = element_text(),
     element_tree = list(test = el_def("element_text", "text"))
   )
   new <- complete_theme(default = gray)
-  expect_s3_class(new$test, "element_text")
+  expect_s3_class(new$test, "ggplot2::element_text")
   reset_theme_settings()
 })