tests/testthat/test-zzz.R

test_that("S7_class validates its underlying data", {
  x <- new_class("X", package = NULL)()
  expect_snapshot_error(S7_data(x) <- 1)
})

test_that("$ gives useful error", {
  foo <- new_class("foo")
  x <- foo()
  expect_snapshot(error = TRUE, {
    x$y
    x$y <- 1
  })

  # But works as expected if inheriting from list
  foo <- new_class("foo", class_list)
  x <- foo()
  x$x <- 1
  expect_equal(x$x, 1)
})

test_that("[ gives more accurate error", {
  expect_snapshot(error = TRUE, {
    x <- new_class("foo")()
    x[1]
    x[1] <- 1
  })

  # but ok if inheriting from list
  x <- new_class("foo", class_list)()
  x[1] <- 1
  expect_equal(x[1], list(1))
})

test_that("[[ gives more accurate error", {
  expect_snapshot(error = TRUE, {
    x <- new_class("foo")()
    x[[1]]
    x[[1]] <- 1
  })

  # but ok if inheriting from list
  x <- new_class("foo", class_list)()
  x[[1]] <- 1
  expect_equal(x[[1]], 1)
})

test_that("register S4 classes for key components", {
  expect_s4_class(getClass("S7_object"), "classRepresentation")
  expect_s4_class(getClass("S7_method"), "classRepresentation")
  expect_s4_class(getClass("S7_generic"), "classRepresentation")
})

Try the S7 package in your browser

Any scripts or data that you put into this service are public.

S7 documentation built on April 3, 2025, 10:50 p.m.