use explicit package=NULL in snapshot tests

tests/testthat/_snaps/class.md

@@ -174,7 +174,8 @@
 # S7 object: displays nicely
 
     Code
-      foo <- new_class("foo", properties = list(x = class_double, y = class_double))
+      foo <- new_class("foo", properties = list(x = class_double, y = class_double),
+      package = NULL)
       foo()
     Output
       <foo>
@@ -191,7 +192,7 @@
 # S7 object: displays objects with data nicely
 
     Code
-      text <- new_class("text", class_character)
+      text <- new_class("text", class_character, package = NULL)
       text("x")
     Output
       <text> chr "x"

tests/testthat/_snaps/inherits.md

@@ -9,8 +9,8 @@
 # throws informative error
 
     Code
-      foo1 <- new_class("foo1")
-      foo2 <- new_class("foo2")
+      foo1 <- new_class("foo1", package = NULL)
+      foo2 <- new_class("foo2", package = NULL)
       check_is_S7(foo1(), foo2)
     Condition
       Error:

tests/testthat/_snaps/super.md

@@ -1,7 +1,7 @@
 # super(): checks to
 
     Code
-      foo <- new_class("foo")
+      foo <- new_class("foo", package = NULL)
       super(foo(), class_character)
     Condition
       Error in `super()`:

tests/testthat/_snaps/union.md

@@ -1,8 +1,8 @@
 # has useful print method
 
     Code
-      foo1 <- new_class("foo1")
-      foo2 <- new_class("foo2")
+      foo1 <- new_class("foo1", package = NULL)
+      foo2 <- new_class("foo2", package = NULL)
       new_union(foo1, foo2)
     Output
       <S7_union>: <foo1> or <foo2>

tests/testthat/helper.R

@@ -140,21 +140,3 @@ dbg <- function(..., .display = utils::str, .file = NULL) {
 }
 
 `%error%` <- function(x, y) tryCatch(x, error = function(e) y)
-
-# prevent new_class() from creating `S7::` prefixed S3 class names in tests.
-{
-  body(topNamespaceName) <- bquote({
-    if (testthat::testing_package() == "S7") {
-      return()
-    }
-
-    .(body(topNamespaceName))
-  })
-
-  local({
-    ns <- asNamespace("S7")
-    unlockBinding("topNamespaceName", ns)
-    ns$topNamespaceName <- topNamespaceName
-    lockBinding("topNamespaceName", ns)
-  })
-}

tests/testthat/test-S3.R

@@ -3,7 +3,7 @@ test_that("new_S3_class has a print method", {
 })
 
 test_that("can construct objects that extend S3 classes", {
-  ordered2 <- new_class("ordered2", parent = class_factor)
+  ordered2 <- new_class("ordered2", parent = class_factor, package = NULL)
   x <- ordered2(c(1L, 2L, 1L), letters[1:3])
   expect_equal(class(x), c("ordered2", "factor", "S7_object"))
   expect_equal(prop_names(x), character())
@@ -15,7 +15,7 @@ test_that("subclasses inherit validator", {
     function(.data) structure(.data, class = "foo"),
     function(x) if (!is.double(x)) "Underlying data must be a double"
   )
-  foo2 <- new_class("foo2", foo)
+  foo2 <- new_class("foo2", foo, package = NULL)
 
   expect_snapshot(error = TRUE, foo2("a"))
 })

tests/testthat/test-class-spec.R

@@ -1,5 +1,5 @@
 test_that("can work with S7 classes", {
-  klass <- new_class("klass")
+  klass <- new_class("klass", package = NULL)
   expect_equal(as_class(klass), klass)
 
   expect_equal(class_type(klass), "S7")
@@ -35,8 +35,8 @@ test_that("can work with S7 classes in packages", {
 })
 
 test_that("can work with unions", {
-  text <- new_class("text", class_character)
-  number <- new_class("number", class_double)
+  text <- new_class("text", class_character, package = NULL)
+  number <- new_class("number", class_double, package = NULL)
   klass <- new_union(text, number)
   expect_equal(as_class(klass), klass)
 
@@ -144,7 +144,8 @@ test_that("can work with S3 classes", {
 
 test_that("can work with S7 classes that extend S3 classes", {
   Date <- new_S3_class("Date", constructor = function(.data = numeric()) .Date(.data))
-  Date2 <- new_class("Date2", parent = Date, properties = list(x = class_numeric))
+  Date2 <- new_class("Date2", parent = Date, properties = list(x = class_numeric),
+                     package = NULL)
 
   expect_equal(class_type(Date2), "S7")
   expect_equal(class_dispatch(Date2), c("Date2", "Date", "S7_object"))

tests/testthat/test-class.R

@@ -11,8 +11,8 @@ describe("S7 classes", {
   })
 
   it("print nicely", {
-    foo1 <- new_class("foo1", properties = list(x = class_integer, y = class_integer))
-    foo2 <- new_class("foo2", foo1)
+    foo1 <- new_class("foo1", properties = list(x = class_integer, y = class_integer), package = NULL)
+    foo2 <- new_class("foo2", foo1, package = NULL)
 
     expect_snapshot({
       foo2
@@ -85,8 +85,8 @@ describe("abstract classes", {
     })
   })
   it("can construct concrete subclasses", {
-    foo1 <- new_class("foo1", abstract = TRUE)
-    foo2 <- new_class("foo2", parent = foo1)
+    foo1 <- new_class("foo1", abstract = TRUE, package = NULL)
+    foo2 <- new_class("foo2", parent = foo1, package = NULL)
     expect_s3_class(foo2(), "foo2")
   })
   it("can use inherited validator from abstract class", {
@@ -96,9 +96,10 @@ describe("abstract classes", {
       abstract = TRUE,
       validator = function(self) {
         if (self@x == 2) "@x has bad value"
-      }
+      },
+      package = NULL
     )
-    foo2 <- new_class("foo2", parent = foo1)
+    foo2 <- new_class("foo2", parent = foo1, package = NULL)
     expect_no_error(foo2(x = 1))
     expect_snapshot(foo2(x = 2), error = TRUE)
   })
@@ -112,7 +113,8 @@ describe("new_object()", {
   it("validates object", {
     foo <- new_class("foo",
       properties = list(x = new_property(class_double)),
-      validator = function(self) if (self@x < 0) "x must be positive"
+      validator = function(self) if (self@x < 0) "x must be positive",
+      package = NULL
     )
 
     expect_snapshot(error = TRUE, {
@@ -136,23 +138,24 @@ describe("new_object()", {
 
 describe("S7 object", {
   it("has an S7 and S3 class", {
-    foo <- new_class("foo")
+    foo <- new_class("foo", package = NULL)
     x <- foo()
     expect_equal(S7_class(x), foo)
     expect_equal(class(x), c("foo", "S7_object"))
   })
 
   it("displays nicely", {
     expect_snapshot({
-      foo <- new_class("foo", properties = list(x = class_double, y = class_double))
+      foo <- new_class("foo", properties = list(x = class_double, y = class_double),
+                       package = NULL)
       foo()
       str(list(foo()))
     })
   })
 
   it("displays objects with data nicely", {
     expect_snapshot({
-      text <- new_class("text", class_character)
+      text <- new_class("text", class_character, package = NULL)
       text("x")
       str(list(text("x")))
     })
@@ -162,7 +165,8 @@ describe("S7 object", {
     foo1 <- new_class(
       "foo1",
       parent = class_list,
-      properties = list(x = class_double, y = class_list)
+      properties = list(x = class_double, y = class_list),
+      package = NULL
     )
     expect_snapshot(
       foo1(
@@ -213,8 +217,8 @@ describe("default constructor", {
   })
 
   it("initializes property with S7 object", {
-    foo1 <- new_class("foo1")
-    foo2 <- new_class("foo2", properties = list(x = foo1))
+    foo1 <- new_class("foo1", package = NULL)
+    foo2 <- new_class("foo2", properties = list(x = foo1), package = NULL)
     x <- foo2()
     expect_s3_class(x@x, "foo1")
   })

tests/testthat/test-constructor.R

@@ -164,7 +164,7 @@ test_that("can create constructors with missing or lazy defaults", {
 
 test_that("Dynamic settable properties are included in constructor", {
   Foo <- new_class(
-    name = "Foo",
+    name = "Foo", package = NULL,
     properties = list(
       dynamic_settable = new_property(
         class_numeric,

tests/testthat/test-convert.R

@@ -1,6 +1,6 @@
 test_that("can register convert methods", {
   local_methods(convert)
-  converttest <- new_class("converttest")
+  converttest <- new_class("converttest", package = NULL)
   method(convert, list(converttest, class_character)) <- function(from, to, ...) "c"
   method(convert, list(converttest, class_integer)) <- function(from, to, ...) "i"
 
@@ -25,17 +25,17 @@ describe("fallback convert", {
   local_methods(convert)
 
   it("can convert to own class", {
-    foo1 <- new_class("foo1")
-    foo2 <- new_class("foo2", foo1)
+    foo1 <- new_class("foo1", package = NULL)
+    foo2 <- new_class("foo2", foo1, package = NULL)
 
     obj <- convert(foo2(), to = foo2)
     expect_equal(class(obj), c("foo2", "foo1", "S7_object"))
     expect_equal(S7_class(obj), foo2)
   })
 
   it("can convert to super class", {
-    foo1 <- new_class("foo1", properties = list(x = class_double))
-    foo2 <- new_class("foo2", foo1, properties = list(y = class_double))
+    foo1 <- new_class("foo1", properties = list(x = class_double), package = NULL)
+    foo2 <- new_class("foo2", foo1, properties = list(y = class_double), package = NULL)
 
     obj <- convert(foo2(1, 2), to = foo1)
     expect_equal(class(obj), c("foo1", "S7_object"))

tests/testthat/test-generic.R

@@ -31,7 +31,7 @@ test_that("check_dispatch_args() produces informative errors", {
 
 test_that("S7_generic printing", {
   foo1 <- new_generic("foo1", "x")
-  text <- new_class("text")
+  text <- new_class("text", package = NULL)
 
   method(foo1, class_character) <- function(x) 1
   method(foo1, text) <- function(x) 2

tests/testthat/test-inherits.R

@@ -15,8 +15,8 @@ test_that("checks that input is a class", {
 
 test_that("throws informative error", {
   expect_snapshot(error = TRUE, {
-    foo1 <- new_class("foo1")
-    foo2 <- new_class("foo2")
+    foo1 <- new_class("foo1", package = NULL)
+    foo2 <- new_class("foo2", package = NULL)
     check_is_S7(foo1(), foo2)
   })
   expect_snapshot(check_is_S7("a"), error = TRUE)

tests/testthat/test-method-dispatch.R

@@ -133,7 +133,7 @@ test_that("can dispatch on base 'union' types", {
 test_that("single dispatch fails with informative messages", {
   fail <- new_generic("fail", "x")
 
-  foo <- new_class("foo")
+  foo <- new_class("foo", package = NULL)
   Foo <- setClass("Foo", slots = list("x" = "numeric"))
   on.exit(S4_remove_classes("Foo"))
 

tests/testthat/test-method-introspect.R

@@ -39,8 +39,8 @@ describe("method introspection", {
 
 describe("method explanation", {
   it("shows all possible methods along with matches", {
-    foo1 <- new_class("foo1")
-    foo2 <- new_class("foo2", foo1)
+    foo1 <- new_class("foo1", package = NULL)
+    foo2 <- new_class("foo2", foo1, package = NULL)
 
     add <- new_generic("add", c("x", "y"))
     method(add, list(foo2, foo1)) <- function(x, y) c(2, 1)

tests/testthat/test-method-register.R

@@ -73,7 +73,7 @@ describe("method registration", {
 
   it("can register S7 method for S4 generic", {
     methods::setGeneric("bar", function(x) standardGeneric("bar"))
-    S4foo <- new_class("S4foo")
+    S4foo <- new_class("S4foo", package = NULL)
 
     expect_snapshot_error(method(bar, S4foo) <- function(x) "foo")
 

tests/testthat/test-property.R

@@ -1,6 +1,6 @@
 describe("property retrieval", {
   it("retrieves the properties that exist & errors otherwise", {
-    foo <- new_class("foo", properties = list(xyz = class_double))
+    foo <- new_class("foo", properties = list(xyz = class_double), package = NULL)
     obj <- foo(1)
     expect_equal(prop(obj, "xyz"), 1)
     expect_equal(obj@xyz, 1)
@@ -48,15 +48,15 @@ describe("prop setting", {
   })
 
   it("can't set read-only properties", {
-    foo <- new_class("foo", properties = list(
+    foo <- new_class("foo", package = NULL, properties = list(
       x = new_property(getter = function(self) 1
     )))
     obj <- foo()
     expect_snapshot(obj@x <- 1, error = TRUE)
   })
 
   it("errors if the property doesn't exist or is wrong class", {
-    foo <- new_class("foo", properties = list(x = class_double))
+    foo <- new_class("foo", properties = list(x = class_double), package = NULL)
     expect_snapshot(error = TRUE, {
       obj <- foo(123)
       obj@foo <- 10
@@ -65,7 +65,7 @@ describe("prop setting", {
   })
 
   it("validates all attributes if custom setter", {
-    foo <- new_class("foo", properties = list(
+    foo <- new_class("foo", package = NULL, properties = list(
       x = new_property(
         class_double,
         setter = function(self, value) {
@@ -239,10 +239,11 @@ describe("new_property()", {
 })
 
 test_that("properties can be base, S3, S4, S7, or S7 union", {
-  class_S7 <- new_class("class_S7")
+  class_S7 <- new_class("class_S7", package = NULL)
   class_S4 <- methods::setClass("class_S4", slots = c(x = "numeric"))
 
   my_class <- new_class("my_class",
+    package = NULL,
     properties = list(
       anything = class_any,
       null = NULL,
@@ -322,7 +323,7 @@ test_that("can validate with custom validator", {
     }
   }
   prop <- new_property(class_integer, validator = validate_scalar)
-  foo <- new_class("foo", properties = list(x = prop))
+  foo <- new_class("foo", package = NULL, properties = list(x = prop))
   expect_snapshot(error = TRUE, {
     f <- foo(x = 1L)
     f@x <- 1:2

tests/testthat/test-super.R

@@ -31,14 +31,14 @@ describe("super()", {
 
   it("checks to", {
     expect_snapshot(error = TRUE, {
-      foo <- new_class("foo")
+      foo <- new_class("foo", package = NULL)
       super(foo(), class_character)
     })
   })
 
   it("displays nicely", {
-    foo1 <- new_class("foo1")
-    foo2 <- new_class("foo2", foo1)
+    foo1 <- new_class("foo1", package = NULL)
+    foo2 <- new_class("foo2", foo1, package = NULL)
 
     expect_snapshot({
       f1 <- super(foo2(), foo1)

tests/testthat/test-union.R

@@ -1,7 +1,7 @@
 test_that("has useful print method", {
   expect_snapshot({
-    foo1 <- new_class("foo1")
-    foo2 <- new_class("foo2")
+    foo1 <- new_class("foo1", package = NULL)
+    foo2 <- new_class("foo2", package = NULL)
     new_union(foo1, foo2)
   })
 })