tests/testthat/test-ggproto.R

In ggplot2: Create Elegant Data Visualisations Using the Grammar of Graphics

test_that(".DollarNames retrieves inherited methods", {
  A <- ggproto("A", NULL, a = 1)
  B <- ggproto("B", A, b = 2)

  expect_equal(.DollarNames(B), c("b", "a"))
})

test_that("construction checks input", {
  expect_snapshot_error(ggproto("Test", NULL, function(self, a) a))
  expect_snapshot_error(ggproto("Test", NULL, a <- function(self, a) a))
  expect_snapshot_error(ggproto("Test", mtcars, a = function(self, a) a))
})

test_that("all ggproto methods start with `{` (#6459)", {

  ggprotos <- Filter(
    function(x) inherits(x, "ggproto"),
    mget(ls("package:ggplot2"), asNamespace("ggplot2"), ifnotfound = list(NULL))
  )

  lacks_brackets <- function(method) {
    if (!inherits(method, "ggproto_method")) {
      return(FALSE)
    }
    body <- as.list(body(environment(method)$f))
    if (length(body) == 0 || body[[1]] != quote(`{`)) {
      return(TRUE)
    }
    return(FALSE)
  }

  report_no_bracket <- function(ggproto_class) {
    unlist(lapply(
      ls(envir = ggproto_class),
      function(method) {
        has_brackets <- !lacks_brackets(ggproto_class[[method]])
        if (has_brackets) {
          return(character())
        }
        return(method)
      }
    ))
  }

  # Test to make sure we're testing correctly
  ctrl <- list(
    foo = ggproto("Dummy", dummy = function(x) x + 10),
    bar = ggproto("Dummy", dummy = function(x) {x + 10})
  )
  ctrl <- lapply(ctrl, report_no_bracket)
  expect_equal(ctrl, list(foo = "dummy", bar = character()))

  # Actual relevant test
  failures <- lapply(ggprotos, report_no_bracket)
  failures <- failures[lengths(failures) > 0]
  expect_equal(names(failures), character())
})