From 676a9345cb7151d2a165ed7ec330f16d28f5f942 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 29 May 2026 12:29:58 -0500
Subject: [PATCH 1/2] Introduce `stop2()` helper

With explicit `call` and `class` arguments. Then use it in lots of places. I didn't try to be exhaustive, but this is an overall improvement and we can chip away at the remaining issues over time.

Fixes #646
---
 NEWS.md                                    |  1 +
 R/S3.R                                     | 12 +--
 R/S4.R                                     |  9 ++-
 R/base-environment.R                       |  4 +-
 R/base.R                                   |  2 +-
 R/class-spec.R                             | 17 ++--
 R/class.R                                  | 44 +++++-----
 R/constructor.R                            |  2 +-
 R/convert.R                                |  8 +-
 R/generic-spec.R                           | 20 ++---
 R/generic.R                                | 28 ++++---
 R/inherits.R                               | 11 ++-
 R/method-dispatch.R                        |  3 +-
 R/method-introspect.R                      | 17 ++--
 R/method-register.R                        | 93 ++++++++++++++--------
 R/property.R                               | 50 ++++++------
 R/super.R                                  |  4 +-
 R/union.R                                  |  5 +-
 R/utils.R                                  | 33 ++++++--
 R/valid.R                                  | 35 +++++---
 R/zzz.R                                    |  8 +-
 man/S7_inherits.Rd                         | 10 ++-
 man/as_class.Rd                            |  2 +-
 man/super.Rd                               |  8 +-
 tests/testthat/_snaps/S3.md                |  6 +-
 tests/testthat/_snaps/S4.md                |  4 +-
 tests/testthat/_snaps/base-environment.md  |  6 +-
 tests/testthat/_snaps/class.md             | 28 +++----
 tests/testthat/_snaps/generic.md           |  8 +-
 tests/testthat/_snaps/method-introspect.md |  8 +-
 tests/testthat/_snaps/method-register.md   | 10 +--
 tests/testthat/_snaps/property.md          | 10 +--
 tests/testthat/_snaps/super.md             |  4 +-
 tests/testthat/_snaps/valid.md             | 10 +--
 tests/testthat/_snaps/zzz.md               |  8 +-
 35 files changed, 309 insertions(+), 219 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 02f47b9d..4a8359c7 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,5 +1,6 @@
 # S7 (development version)
 
+* Errors thrown by S7 now report the function where they occurred, making it easier to track down the source of a problem (#646).
 * `method<-` now accepts `NULL` to unregister an existing method, e.g. `method(foo, class_character) <- NULL` (#613).
 * `new_object()` no longer materialises ALTREP parent values (e.g. `seq_len()`), so constructing an S7 object that wraps a large compact integer sequence is now O(1) in memory instead of O(n) (@kschaubroeck, #607).
 * Internal changes to support R-devel (4.6) (#592, #593, #598, #600).
diff --git a/R/S3.R b/R/S3.R
index 8cd0b023..0932841e 100644
--- a/R/S3.R
+++ b/R/S3.R
@@ -90,15 +90,15 @@
 #' my_generic(Sys.Date())
 new_S3_class <- function(class, constructor = NULL, validator = NULL) {
   if (!is.character(class)) {
-    stop("`class` must be a character vector.")
+    stop2("`class` must be a character vector.")
   }
   if (!is.null(constructor)) {
     check_S3_constructor(constructor)
   } else {
     constructor <- function(.data) {
-      stop(
+      stop2(
         sprintf("S3 class <%s> doesn't have a constructor.", class[[1]]),
-        call. = FALSE
+        call = NULL
       )
     }
   }
@@ -130,13 +130,13 @@ nameOfClass.S7_S3_class <- function(x) {
   x[["class"]]
 }
 
-check_S3_constructor <- function(constructor) {
+check_S3_constructor <- function(constructor, call = sys.call(-1L)) {
   arg_names <- names(formals(constructor))
   if (arg_names[[1]] != ".data") {
-    stop("First argument to `constructor` must be .data.", call. = FALSE)
+    stop2("First argument to `constructor` must be .data.", call = call)
   }
   if ("..." %in% arg_names) {
-    stop("`constructor` can not use `...`.", call. = FALSE)
+    stop2("`constructor` can not use `...`.", call = call)
   }
 }
 
diff --git a/R/S4.R b/R/S4.R
index 82f0d0b4..88937ba9 100644
--- a/R/S4.R
+++ b/R/S4.R
@@ -29,7 +29,7 @@ S4_register <- function(class, env = parent.frame()) {
       "`class` must be an S7 class or an S3 class, not a %s.",
       obj_desc(class)
     )
-    stop(msg, call. = FALSE)
+    stop2(msg)
   }
 
   methods::setOldClass(classes, where = topenv(env))
@@ -38,7 +38,7 @@ S4_register <- function(class, env = parent.frame()) {
 
 is_S4_class <- function(x) inherits(x, "classRepresentation")
 
-S4_to_S7_class <- function(x, error_base = "") {
+S4_to_S7_class <- function(x, error_base = "", call = sys.call(-1L)) {
   # Silence R CMD check false positives
   distance <- subClass <- className <- package <- NULL
 
@@ -46,7 +46,8 @@ S4_to_S7_class <- function(x, error_base = "") {
   if (methods::is(x, "classGeneratorFunction")) {
     return(S4_to_S7_class(
       methods::getClass(as.character(x@className)),
-      error_base
+      error_base,
+      call = call
     ))
   }
 
@@ -71,7 +72,7 @@ S4_to_S7_class <- function(x, error_base = "") {
       "Unsupported S4 object: must be a class generator or a class definition, not a %s.",
       obj_desc(x)
     )
-    stop(paste0(error_base, msg), call. = FALSE)
+    stop2(paste0(error_base, msg), call = call)
   }
 }
 
diff --git a/R/base-environment.R b/R/base-environment.R
index c1cd3d17..f573614c 100644
--- a/R/base-environment.R
+++ b/R/base-environment.R
@@ -31,7 +31,7 @@
 #' counter$n
 class_environment <- NULL
 
-check_not_environment <- function(object, fn) {
+check_not_environment <- function(object, fn, call = sys.call(-1L)) {
   if (!is.environment(object)) {
     return(invisible())
   }
@@ -40,7 +40,7 @@ check_not_environment <- function(object, fn) {
     sprintf("Can't call `%s` on an environment.\n", fn),
     "See ?class_environment for details."
   )
-  stop(msg, call. = FALSE)
+  stop2(msg, call = call)
 }
 
 # Define onload to avoid dependencies between files
diff --git a/R/base.R b/R/base.R
index 54f67c88..8f18a298 100644
--- a/R/base.R
+++ b/R/base.R
@@ -78,7 +78,7 @@ base_S7_class <- function(x) {
     call = class_call,
     `function` = class_function,
     environment = class_environment,
-    stop(sprintf("No S7 class for base type <%s>.", typeof(x)), call. = FALSE)
+    stop2(sprintf("No S7 class for base type <%s>.", typeof(x)), call = NULL)
   )
 }
 
diff --git a/R/class-spec.R b/R/class-spec.R
index 03fb7fe4..6075b79a 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -12,7 +12,7 @@
 #'   * A base class, like [class_logical], [class_integer], or [class_double].
 #'   * A "special", either [class_missing] or [class_any].
 #' @param arg Argument name used when generating errors.
-#' @keywords internal
+#' @keywords interna
 #' @export
 #' @return A standardised class: either `NULL`, an S7 class, an S7 union,
 #'   as [new_S3_class], or a S4 class.
@@ -29,9 +29,10 @@ as_class <- function(x, arg = deparse(substitute(x))) {
     # so it can't be wrapped in new_base_class
     x
   } else if (isS4(x)) {
-    S4_to_S7_class(x, error_base)
+    S4_to_S7_class(x, error_base, call = sys.call(-1L))
   } else {
     msg <- c(
+      error_base,
       sprintf(
         "Class specification must be one of the following, not a %s:",
         obj_desc(x)
@@ -42,7 +43,7 @@ as_class <- function(x, arg = deparse(substitute(x))) {
       " * A base class"
     )
 
-    stop(paste0(c(error_base, msg), collapse = "\n"))
+    stop2(msg)
   }
 }
 
@@ -73,7 +74,7 @@ class_type <- function(x) {
   } else if (is_S4_class(x)) {
     "S4"
   } else {
-    stop("`x` is not a standard S7 class.", call. = FALSE)
+    stop2("`x` is not a standard S7 class.", call = NULL)
   }
 }
 
@@ -121,7 +122,7 @@ class_construct_expr <- function(.x, envir = NULL, package = NULL) {
           f@package,
           f@name
         )
-        stop(msg, call. = FALSE)
+        stop2(msg, call = NULL)
       }
       return(as.call(list(cl)))
     }
@@ -184,7 +185,7 @@ class_constructor <- function(.x) {
     S7_base = .x$constructor,
     S7_union = class_constructor(.x$classes[[1]]),
     S7_S3 = .x$constructor,
-    stop(sprintf("Can't construct %s.", class_friendly(.x)), call. = FALSE)
+    stop2(sprintf("Can't construct %s.", class_friendly(.x)), call = NULL)
   )
 }
 
@@ -252,7 +253,7 @@ class_dispatch <- function(x) {
     S7 = c(S7_class_name(x), class_dispatch(x@parent)),
     S7_base = c(x$class, "S7_object"),
     S7_S3 = c(x$class, "S7_object"),
-    stop("Unsupported class type.", call. = FALSE)
+    stop2("Unsupported class type.", call = NULL)
   )
 }
 
@@ -267,7 +268,7 @@ class_register <- function(x) {
     S7 = S7_class_name(x),
     S7_base = x$class,
     S7_S3 = x$class[[1]],
-    stop("Unsupported class type.", call. = FALSE)
+    stop2("Unsupported class type.", call = NULL)
   )
 }
 
diff --git a/R/class.R b/R/class.R
index 0b5463f5..39186a69 100644
--- a/R/class.R
+++ b/R/class.R
@@ -126,7 +126,7 @@ new_class <- function(
       abstract &&
         (!is_class(parent) || !(parent@abstract || parent@name == "S7_object"))
     ) {
-      stop("Abstract classes must have abstract parents.")
+      stop2("Abstract classes must have abstract parents.")
     }
   }
 
@@ -174,14 +174,14 @@ S7_class_name <- function(x) {
   paste(c(x@package, x@name), collapse = "::")
 }
 
-check_S7_constructor <- function(constructor) {
+check_S7_constructor <- function(constructor, call = sys.call(-1L)) {
   if (!is.function(constructor)) {
-    stop("`constructor` must be a function.", call. = FALSE)
+    stop2("`constructor` must be a function.", call = call)
   }
 
   method_call <- find_call(body(constructor), quote(new_object), packageName())
   if (is.null(method_call)) {
-    stop("`constructor` must contain a call to `new_object()`.", call. = FALSE)
+    stop2("`constructor` must contain a call to `new_object()`.", call = call)
   }
 }
 
@@ -235,31 +235,34 @@ str.S7_class <- function(object, ..., nest.lev = 0) {
 
 #' @export
 c.S7_class <- function(...) {
-  msg <- "Can not combine S7 class objects."
-  stop(msg)
+  stop2("Can not combine S7 class objects.")
 }
 
 can_inherit <- function(x) is_base_class(x) || is_S3_class(x) || is_class(x)
 
-check_can_inherit <- function(x, arg = deparse(substitute(x))) {
+check_can_inherit <- function(
+  x,
+  arg = deparse(substitute(x)),
+  call = sys.call(-1L)
+) {
   if (!can_inherit(x)) {
     msg <- sprintf(
       "`%s` must be an S7 class, S3 class, or base type, not %s.",
       arg,
       class_friendly(x)
     )
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 }
 
 is_class <- function(x) inherits(x, "S7_class")
 
-check_parent <- function(parent, class) {
+check_parent <- function(parent, class, call = sys.call(-1L)) {
   parent_class <- class@parent
   if (is.null(parent_class)) {
-    stop(
+    stop2(
       "`.parent` must not be supplied when class has no parent.",
-      call. = FALSE
+      call = call
     )
   }
 
@@ -276,7 +279,7 @@ check_parent <- function(parent, class) {
     class_desc(parent_class),
     obj_desc(parent)
   )
-  stop(msg, call. = FALSE)
+  stop2(msg, call = call)
 }
 
 # Object ------------------------------------------------------------------
@@ -288,14 +291,14 @@ check_parent <- function(parent, class) {
 new_object <- function(.parent, ...) {
   class <- sys.function(-1)
   if (!inherits(class, "S7_class")) {
-    stop("`new_object()` must be called from within a constructor.")
+    stop2("`new_object()` must be called from within a constructor.")
   }
   if (class@abstract) {
     msg <- sprintf(
       "Can't construct an object from abstract class <%s>.",
       class@name
     )
-    stop(msg)
+    stop2(msg)
   }
 
   if (!missing(.parent)) {
@@ -304,7 +307,7 @@ new_object <- function(.parent, ...) {
 
   args <- list(...)
   if ("" %in% names2(args)) {
-    stop("All arguments to `...` must be named.")
+    stop2("All arguments to `...` must be named.")
   }
 
   has_setter <- vlapply(class@properties[names(args)], prop_has_setter)
@@ -330,7 +333,12 @@ new_object <- function(.parent, ...) {
   # i.e. it's a non-abstract S7 class
   parent_validated <- inherits(class@parent, "S7_object") &&
     !class@parent@abstract
-  validate_from(.parent, parent = if (parent_validated) class@parent)
+  validate_from(
+    .parent,
+    parent = if (parent_validated) class@parent,
+    # Attribute validation failures to the constructor call, not new_object()
+    call = sys.call(-1L)
+  )
 
   .parent
 }
@@ -397,7 +405,7 @@ S7_class <- function(object) {
 }
 
 
-check_prop_names <- function(properties, error_call = sys.call(-1L)) {
+check_prop_names <- function(properties, call = sys.call(-1L)) {
   # these attributes have special C handlers in base R
   forbidden <- c(
     "names",
@@ -416,6 +424,6 @@ check_prop_names <- function(properties, error_call = sys.call(-1L)) {
       paste0(forbidden, collapse = ", "),
       "."
     )
-    stop(simpleError(msg, error_call))
+    stop2(msg, call = call)
   }
 }
diff --git a/R/constructor.R b/R/constructor.R
index 55755110..83cc88f7 100644
--- a/R/constructor.R
+++ b/R/constructor.R
@@ -44,7 +44,7 @@ new_constructor <- function(
     args[names(arg_info$self)] <- arg_info$self
   } else {
     # user facing error in S7_class()
-    stop("Unsupported `parent` type.", call. = FALSE)
+    stop2("Unsupported `parent` type.", call = NULL)
   }
 
   # ensure default value for `...` is empty
diff --git a/R/convert.R b/R/convert.R
index a943f85b..db0ec3e8 100644
--- a/R/convert.R
+++ b/R/convert.R
@@ -93,12 +93,12 @@ convert <- function(from, to, ...) {
       c("- from: ", obj_desc(from), "\n"),
       c("- to  : ", class_desc(to))
     )
-    stop(msg)
+    stop2(msg)
   }
 }
 
-convert_up <- function(from, to) {
-  check_not_environment(from, "convert()")
+convert_up <- function(from, to, call = sys.call(-1L)) {
+  check_not_environment(from, "convert()", call = call)
 
   from_class <- S7_class(from)
   if (is_class(from_class)) {
@@ -118,7 +118,7 @@ convert_up <- function(from, to) {
     attr(from, "S7_class") <- to
     class(from) <- class_dispatch(to)
   } else {
-    stop("Unreachable.")
+    stop2("Unreachable.")
   }
   from
 }
diff --git a/R/generic-spec.R b/R/generic-spec.R
index d102694e..e0b7233f 100644
--- a/R/generic-spec.R
+++ b/R/generic-spec.R
@@ -5,18 +5,18 @@ is_generic <- function(x) {
     is_S4_generic(x)
 }
 
-as_generic <- function(x) {
+as_generic <- function(x, call = sys.call(-1L)) {
   if (is_generic(x)) {
     x
   } else if (is.function(x)) {
-    as_S3_generic(x)
+    as_S3_generic(x, call = call)
   } else {
     msg <- sprintf("`generic` must be a function, not a %s.", obj_desc(x))
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 }
 
-as_S3_generic <- function(x) {
+as_S3_generic <- function(x, call = sys.call(-1L)) {
   use_method <- find_call(body(x), quote(UseMethod))
   if (!is.null(use_method)) {
     return(S3_generic(x, as.character(use_method[[2]])))
@@ -31,10 +31,12 @@ as_S3_generic <- function(x) {
     }
   }
 
-  stop(
-    "`generic` is a function, but not an S3 generic function:\n",
-    deparse_trunc(x, 100),
-    call. = FALSE
+  stop2(
+    c(
+      "`generic` is a function, but not an S3 generic function:",
+      deparse_trunc(x, 100)
+    ),
+    call = call
   )
 }
 
@@ -77,7 +79,7 @@ generic_n_dispatch <- function(x) {
   } else if (is_S4_generic(x)) {
     length(x@signature)
   } else {
-    stop(sprintf("Invalid input %s.", obj_desc(x)), call. = FALSE)
+    stop2(sprintf("Invalid input %s.", obj_desc(x)), call = NULL)
   }
 }
 
diff --git a/R/generic.R b/R/generic.R
index d9e02c59..60d42bd2 100644
--- a/R/generic.R
+++ b/R/generic.R
@@ -82,33 +82,37 @@ new_generic <- function(name, dispatch_args, fun = NULL) {
   S7_generic(fun, name = name, dispatch_args = dispatch_args)
 }
 
-check_dispatch_args <- function(dispatch_args, fun = NULL) {
+check_dispatch_args <- function(
+  dispatch_args,
+  fun = NULL,
+  call = sys.call(-1L)
+) {
   if (!is.character(dispatch_args)) {
-    stop("`dispatch_args` must be a character vector.", call. = FALSE)
+    stop2("`dispatch_args` must be a character vector.", call = call)
   }
   if (length(dispatch_args) == 0) {
-    stop("`dispatch_args` must have at least one component.", call. = FALSE)
+    stop2("`dispatch_args` must have at least one component.", call = call)
   }
   if (anyDuplicated(dispatch_args)) {
-    stop("`dispatch_args` must be unique.", call. = FALSE)
+    stop2("`dispatch_args` must be unique.", call = call)
   }
   if (any(is.na(dispatch_args) | dispatch_args == "")) {
-    stop(
+    stop2(
       "`dispatch_args` must not be missing or the empty string.",
-      call. = FALSE
+      call = call
     )
   }
   if ("..." %in% dispatch_args) {
-    stop("Can't dispatch on `...`.", call. = FALSE)
+    stop2("Can't dispatch on `...`.", call = call)
   }
 
   if (!is.null(fun)) {
     arg_names <- names(formals(fun))
 
     if (!is_prefix(dispatch_args, arg_names)) {
-      stop(
+      stop2(
         "`dispatch_args` must be a prefix of the generic arguments.",
-        call. = FALSE
+        call = call
       )
     }
   }
@@ -135,14 +139,14 @@ print.S7_generic <- function(x, ...) {
   invisible(x)
 }
 
-check_generic <- function(fun) {
+check_generic <- function(fun, call = sys.call(-1L)) {
   if (!is.function(fun)) {
-    stop("`fun` must be a function.", call. = FALSE)
+    stop2("`fun` must be a function.", call = call)
   }
 
   dispatch_call <- find_call(body(fun), quote(S7_dispatch), packageName())
   if (is.null(dispatch_call)) {
-    stop("`fun` must contain a call to `S7_dispatch()`.", call. = FALSE)
+    stop2("`fun` must contain a call to `S7_dispatch()`.", call = call)
   }
 }
 
diff --git a/R/inherits.R b/R/inherits.R
index 43ad139d..2e2dce3d 100644
--- a/R/inherits.R
+++ b/R/inherits.R
@@ -9,6 +9,8 @@
 #'   [class_integer], or [class_any]/[class_missing]). If `NULL`, only tests
 #'   whether `x` is an S7 object, without testing for a specific class.
 #' @param arg Argument name used in error message.
+#' @param call The call to report in the error message. Defaults to the
+#'   calling function.
 #' @returns
 #' * `S7_inherits()` returns a single `TRUE` or `FALSE`.
 #' * `check_is_S7()` returns nothing; it's called for its side-effects.
@@ -47,7 +49,12 @@ S7_inherits <- function(x, class = NULL) {
 #' @export
 #' @rdname S7_inherits
 # called from src/prop.c
-check_is_S7 <- function(x, class = NULL, arg = deparse(substitute(x))) {
+check_is_S7 <- function(
+  x,
+  class = NULL,
+  arg = deparse(substitute(x)),
+  call = sys.call(-1L)
+) {
   class <- as_class(class)
   if (S7_inherits(x, class)) {
     return(invisible())
@@ -59,5 +66,5 @@ check_is_S7 <- function(x, class = NULL, arg = deparse(substitute(x))) {
     if (is.null(class)) "an <S7_object>" else paste0("a ", class_desc(class)),
     obj_desc(x)
   )
-  stop(msg, call. = FALSE)
+  stop2(msg, call = call)
 }
diff --git a/R/method-dispatch.R b/R/method-dispatch.R
index 35e14bd2..69a8d08d 100644
--- a/R/method-dispatch.R
+++ b/R/method-dispatch.R
@@ -2,8 +2,7 @@
 method_lookup_error <- function(name, args) {
   types <- vcapply(args, obj_desc)
   msg <- method_lookup_error_message(name, types)
-  cnd <- errorCondition(msg, class = "S7_error_method_not_found")
-  stop(cnd)
+  stop2(msg, call = NULL, class = "S7_error_method_not_found")
 }
 
 method_lookup_error_message <- function(name, types) {
diff --git a/R/method-introspect.R b/R/method-introspect.R
index 1156531a..81d9db8e 100644
--- a/R/method-introspect.R
+++ b/R/method-introspect.R
@@ -50,7 +50,7 @@ method <- function(generic, class = NULL, object = NULL) {
   # argument values in the dispatch environment, which doesn't exist here
   types <- error_types(generic, class = class, object = object)
   msg <- method_lookup_error_message(generic@name, types)
-  stop(msg)
+  stop2(msg)
 }
 
 #' Explain method dispatch
@@ -109,12 +109,17 @@ method_explain <- function(generic, class = NULL, object = NULL) {
 }
 
 
-as_dispatch <- function(generic, class = NULL, object = NULL) {
+as_dispatch <- function(
+  generic,
+  class = NULL,
+  object = NULL,
+  call = sys.call(-1L)
+) {
   if (!is.null(class) && is.null(object)) {
-    signature <- as_signature(class, generic)
+    signature <- as_signature(class, generic, call = call)
     is_union <- vlapply(signature, is_union)
     if (any(is_union)) {
-      stop("Can't dispatch on unions; must be a concrete type.", call. = FALSE)
+      stop2("Can't dispatch on unions; must be a concrete type.", call = call)
     }
 
     lapply(signature, class_dispatch)
@@ -123,11 +128,11 @@ as_dispatch <- function(generic, class = NULL, object = NULL) {
     if (n == 1) {
       object <- list(object)
     } else {
-      check_signature_list(object, n = n, arg = "object")
+      check_signature_list(object, n = n, arg = "object", call = call)
     }
     lapply(object, obj_dispatch)
   } else {
-    stop("Must supply exactly one of `class` and `object`.", call. = FALSE)
+    stop2("Must supply exactly one of `class` and `object`.", call = call)
   }
 }
 
diff --git a/R/method-register.R b/R/method-register.R
index 47f819b6..b44a4827 100644
--- a/R/method-register.R
+++ b/R/method-register.R
@@ -71,25 +71,34 @@ register_method <- function(
   signature,
   method,
   env = parent.frame(),
-  package = packageName(env)
+  package = packageName(env),
+  call = sys.call(-1L)
 ) {
-  generic <- as_generic(generic)
-  signature <- as_signature(signature, generic)
+  generic <- as_generic(generic, call = call)
+  signature <- as_signature(signature, generic, call = call)
 
   if (is_external_generic(generic) && isNamespaceLoaded(generic$package)) {
-    generic <- as_generic(getFromNamespace(generic$name, generic$package))
+    generic <- as_generic(
+      getFromNamespace(generic$name, generic$package),
+      call = call
+    )
   }
 
   # Register in current session
   if (is_S7_generic(generic)) {
-    check_method(method, generic, name = method_name(generic, signature))
+    check_method(
+      method,
+      generic,
+      name = method_name(generic, signature),
+      call = call
+    )
     register_S7_method(generic, signature, method)
   } else if (is_S3_generic(generic)) {
-    register_S3_method(generic, signature, method, env)
+    register_S3_method(generic, signature, method, env, call = call)
   } else if (is_S4_generic(generic)) {
     signatures <- flatten_signature(signature)
     for (signature in signatures) {
-      register_S4_method(generic, signature, method, env)
+      register_S4_method(generic, signature, method, env, call = call)
     }
   }
 
@@ -107,22 +116,26 @@ unregister_method <- function(
   generic,
   signature,
   env = parent.frame(),
-  package = packageName(env)
+  package = packageName(env),
+  call = sys.call(-1L)
 ) {
-  generic <- as_generic(generic)
-  signature <- as_signature(signature, generic)
+  generic <- as_generic(generic, call = call)
+  signature <- as_signature(signature, generic, call = call)
 
   if (is_external_generic(generic) && isNamespaceLoaded(generic$package)) {
-    generic <- as_generic(getFromNamespace(generic$name, generic$package))
+    generic <- as_generic(
+      getFromNamespace(generic$name, generic$package),
+      call = call
+    )
   }
 
   # Unregister in current session
   if (is_S7_generic(generic)) {
     unregister_S7_method(generic, signature)
   } else if (is_S3_generic(generic)) {
-    stop("Can't unregister methods for S3 generics", call. = FALSE)
+    stop2("Can't unregister methods for S3 generics", call = call)
   } else if (is_S4_generic(generic)) {
-    stop("Can't unregister methods for S4 generics", call. = FALSE)
+    stop2("Can't unregister methods for S4 generics", call = call)
   }
 
   # If we're inside a package, also remove from the deferred external
@@ -139,7 +152,8 @@ register_S3_method <- function(
   generic,
   signature,
   method,
-  envir = parent.frame()
+  envir = parent.frame(),
+  call = sys.call(-1L)
 ) {
   if (class_type(signature[[1]]) != "S7") {
     msg <- sprintf(
@@ -147,7 +161,7 @@ register_S3_method <- function(
       generic$name,
       class_friendly(signature[[1]])
     )
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 
   if (
@@ -196,7 +210,7 @@ flatten_signature <- function(signature) {
   lapply(rows, function(row) Map("[[", signature, row))
 }
 
-as_signature <- function(signature, generic) {
+as_signature <- function(signature, generic, call = sys.call(-1L)) {
   if (inherits(signature, "S7_signature")) {
     return(signature)
   }
@@ -210,7 +224,7 @@ as_signature <- function(signature, generic) {
     }
     new_signature(list(as_class(signature, arg = "signature")))
   } else {
-    check_signature_list(signature, n)
+    check_signature_list(signature, n, call = call)
     for (i in seq_along(signature)) {
       signature[i] <- list(as_class(
         signature[[i]],
@@ -221,15 +235,20 @@ as_signature <- function(signature, generic) {
   }
 }
 
-check_signature_list <- function(x, n, arg = "signature") {
+check_signature_list <- function(
+  x,
+  n,
+  arg = "signature",
+  call = sys.call(-1L)
+) {
   if (!is.list(x) || is.object(x)) {
-    stop(
+    stop2(
       sprintf("`%s` must be a list for multidispatch generics.", arg),
-      call. = FALSE
+      call = call
     )
   }
   if (length(x) != n) {
-    stop(sprintf("`%s` must be length %i.", arg, n), call. = FALSE)
+    stop2(sprintf("`%s` must be length %i.", arg, n), call = call)
   }
 }
 
@@ -241,10 +260,11 @@ new_signature <- function(x) {
 check_method <- function(
   method,
   generic,
-  name = paste0(generic@name, "(???)")
+  name = paste0(generic@name, "(???)"),
+  call = sys.call(-1L)
 ) {
   if (!is.function(method) || is.primitive(method)) {
-    stop(sprintf("%s must be a function.", name), call. = FALSE)
+    stop2(sprintf("%s must be a function.", name), call = call)
   }
 
   generic_formals <- formals(args(generic))
@@ -267,8 +287,7 @@ check_method <- function(
         show_args(method_formals, name = generic@name)
       )
     )
-    msg <- paste0(c(msg, bullets), collapse = "\n")
-    stop(msg, call. = FALSE)
+    stop2(c(msg, bullets), call = call)
   }
 
   n_dispatch <- length(generic@dispatch_args)
@@ -282,7 +301,7 @@ check_method <- function(
       name,
       arg_names(method_args)
     )
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 
   empty_dispatch <- vlapply(
@@ -296,7 +315,7 @@ check_method <- function(
       name,
       arg_names(generic@dispatch_args)
     )
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 
   extra_args <- setdiff(names(generic_formals), c(generic@dispatch_args, "..."))
@@ -329,14 +348,15 @@ register_S4_method <- function(
   generic,
   signature,
   method,
-  env = parent.frame()
+  env = parent.frame(),
+  call = sys.call(-1L)
 ) {
   S4_env <- topenv(env)
-  S4_signature <- lapply(signature, S4_class, S4_env = S4_env)
+  S4_signature <- lapply(signature, S4_class, S4_env = S4_env, call = call)
   methods::setMethod(generic, S4_signature, method, where = S4_env)
 }
 
-S4_class <- function(x, S4_env) {
+S4_class <- function(x, S4_env, call = sys.call(-1L)) {
   switch(
     class_type(x),
     `NULL` = "NULL",
@@ -344,9 +364,12 @@ S4_class <- function(x, S4_env) {
     any = "ANY",
     S7_base = base_to_S4(x$class),
     S4 = x,
-    S7 = S4_registered_class(x),
-    S7_S3 = S4_registered_class(x),
-    S7_union = stop("Internal error: union should be flattened upstream.")
+    S7 = S4_registered_class(x, call = call),
+    S7_S3 = S4_registered_class(x, call = call),
+    S7_union = stop2(
+      "Internal error: union should be flattened upstream.",
+      call = NULL
+    )
   )
 }
 
@@ -359,7 +382,7 @@ base_to_S4 <- function(class) {
   switch(class, double = "numeric", class)
 }
 
-S4_registered_class <- function(x) {
+S4_registered_class <- function(x, call = sys.call(-1L)) {
   class <- tryCatch(
     methods::getClass(class_register(x)),
     error = function(err) NULL
@@ -369,7 +392,7 @@ S4_registered_class <- function(x) {
       "Class has not been registered with S4; please call S4_register(%s).",
       class_deparse(x)
     )
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
   class
 }
diff --git a/R/property.R b/R/property.R
index 66827b9a..6aa2e971 100644
--- a/R/property.R
+++ b/R/property.R
@@ -123,7 +123,7 @@ new_property <- function(
   out
 }
 
-check_prop_default <- function(default, class, error_call = sys.call(-1)) {
+check_prop_default <- function(default, class, call = sys.call(-1L)) {
   if (is.null(default)) {
     return() # always valid.
   }
@@ -136,11 +136,11 @@ check_prop_default <- function(default, class, error_call = sys.call(-1)) {
   if (is.symbol(default)) {
     if (identical(default, quote(...))) {
       # The meaning of a `...` prop default needs discussion
-      stop(simpleError("`default` cannot be `...`.", error_call))
+      stop2("`default` cannot be `...`.", call = call)
     }
     if (identical(default, quote(expr = ))) {
       # The meaning of a missing prop default needs discussion
-      stop(simpleError("`default` cannot be missing.", error_call))
+      stop2("`default` cannot be missing.", call = call)
     }
 
     # other symbols are treated as promises
@@ -157,11 +157,7 @@ check_prop_default <- function(default, class, error_call = sys.call(-1)) {
     obj_desc(default)
   )
 
-  stop(simpleError(msg, error_call))
-}
-
-stop.parent <- function(..., call = sys.call(-2)) {
-  stop(simpleError(.makeMessage(...), call))
+  stop2(msg, call = call)
 }
 
 is_property <- function(x) inherits(x, "S7_property")
@@ -215,7 +211,7 @@ prop <- function(object, name) {
 }
 
 signal_prop_error_unknown <- function(object, name) {
-  stop(prop_error_unknown(object, name), call. = FALSE)
+  stop2(prop_error_unknown(object, name), call = NULL)
 }
 
 #' @rdname prop
@@ -229,12 +225,12 @@ signal_prop_error_unknown <- function(object, name) {
 # called from src/prop.c
 signal_prop_error <- function(fmt, object, name) {
   msg <- sprintf(fmt, obj_desc(object), name)
-  stop(msg, call. = FALSE)
+  stop2(msg, call = NULL)
 }
 
 # called from src/prop.c
 signal_error <- function(msg) {
-  stop(msg, call. = FALSE)
+  stop2(msg, call = NULL)
 }
 
 
@@ -271,11 +267,14 @@ prop_validate <- function(prop, value, object = NULL) {
     }
   }
 
-  stop(sprintf(
-    "%s validator must return NULL or a character, not <%s>.",
-    prop_label(object, prop$name),
-    typeof(val)
-  ))
+  stop2(
+    sprintf(
+      "%s validator must return NULL or a character, not <%s>.",
+      prop_label(object, prop$name),
+      typeof(val)
+    ),
+    call = NULL
+  )
 }
 
 prop_label <- function(object, name) {
@@ -466,31 +465,36 @@ set_props <- function(object, ..., .check = TRUE) {
   object
 }
 
-as_properties <- function(x) {
+as_properties <- function(x, call = sys.call(-1L)) {
   if (length(x) == 0) {
     return(list())
   }
 
   if (!is.list(x)) {
-    stop("`properties` must be a list.", call. = FALSE)
+    stop2("`properties` must be a list.", call = call)
   }
 
-  out <- Map(as_property, x, names2(x), seq_along(x))
+  out <- Map(
+    function(x, name, i) as_property(x, name, i, call = call),
+    x,
+    names2(x),
+    seq_along(x)
+  )
   names(out) <- vapply(out, function(x) x$name, FUN.VALUE = character(1))
 
   if (anyDuplicated(names(out))) {
-    stop("`properties` names must be unique.", call. = FALSE)
+    stop2("`properties` names must be unique.", call = call)
   }
 
   out
 }
 
-as_property <- function(x, name, i) {
+as_property <- function(x, name, i, call = sys.call(-1L)) {
   if (is_property(x)) {
     if (name == "") {
       if (is.null(x$name)) {
         msg <- sprintf("`properties[[%i]]` must have a name or be named.", i)
-        stop(msg, call. = FALSE)
+        stop2(msg, call = call)
       }
     } else {
       x$name <- name
@@ -499,7 +503,7 @@ as_property <- function(x, name, i) {
   } else {
     if (name == "") {
       msg <- sprintf("`properties[[%i]]` must be named.", i)
-      stop(msg, call. = FALSE)
+      stop2(msg, call = call)
     }
 
     class <- as_class(x, arg = paste0("property$", name))
diff --git a/R/super.R b/R/super.R
index aa900a23..9dc2cbde 100644
--- a/R/super.R
+++ b/R/super.R
@@ -106,7 +106,7 @@ super <- function(from, to) {
       "`to` must be an S7, S3, S4, or base class, not %s.",
       class_friendly(to)
     )
-    stop(msg, call. = FALSE)
+    stop2(msg)
   }
   if (!class_inherits(from, to)) {
     msg <- sprintf(
@@ -114,7 +114,7 @@ super <- function(from, to) {
       obj_desc(from),
       class_desc(to)
     )
-    stop(msg)
+    stop2(msg)
   }
 
   # Must not change order of these fields as C code indexes by position
diff --git a/R/union.R b/R/union.R
index 4f5fd58d..a03b43b3 100644
--- a/R/union.R
+++ b/R/union.R
@@ -82,7 +82,10 @@ str.S7_union <- function(object, ..., nest.lev = 0) {
 }
 
 class_flatten <- function(x) {
-  x <- lapply(x, as_class)
+  x <- lapply(
+    seq_along(x),
+    function(i) as_class(x[[i]], arg = sprintf("..%i", i))
+  )
 
   # Flatten unions
   is_union <- vlapply(x, is_union)
diff --git a/R/utils.R b/R/utils.R
index 430c2343..2c08ea0a 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -23,6 +23,14 @@ paste_c <- function(...) {
   paste(c(...), collapse = "")
 }
 
+stop2 <- function(message, call = sys.call(-1L), class = NULL) {
+  stop(errorCondition(
+    message = paste(message, collapse = "\n"),
+    call = call,
+    class = class
+  ))
+}
+
 method_signature <- function(generic, signature) {
   single <- length(generic@dispatch_args) == 1
   if (single) {
@@ -89,21 +97,30 @@ str_function <- function(object, ..., nest.lev = 0) {
   str(object, ..., nest.lev = nest.lev)
 }
 
-check_name <- function(name, arg = deparse(substitute(name))) {
+check_name <- function(
+  name,
+  arg = deparse(substitute(name)),
+  call = sys.call(-1L)
+) {
   if (length(name) != 1 || !is.character(name)) {
     msg <- sprintf("`%s` must be a single string.", arg)
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
   if (is.na(name) || name == "") {
     msg <- sprintf("`%s` must not be \"\" or NA.", arg)
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 }
 
-check_function <- function(f, args, arg = deparse(substitute(f))) {
+check_function <- function(
+  f,
+  args,
+  arg = deparse(substitute(f)),
+  call = sys.call(-1L)
+) {
   if (!is.function(f)) {
     msg <- sprintf("`%s` must be a function.", arg)
-    stop(msg, call. = FALSE)
+    stop2(msg, call = call)
   }
 
   # `args` is either a single formals list (e.g. alist(self = , value = ))
@@ -129,7 +146,7 @@ check_function <- function(f, args, arg = deparse(substitute(f))) {
     expected,
     show_args(formals(f))
   )
-  stop(msg, call. = FALSE)
+  stop2(msg, call = call)
 }
 
 show_function <- function(x, constructor = FALSE) {
@@ -161,7 +178,7 @@ modify_list <- function(x, new_vals) {
   if (length(new_vals)) {
     nms <- names2(new_vals)
     if (!all(nzchar(nms))) {
-      stop("All elements in `new_vals` must be named.", call. = FALSE)
+      stop2("All elements in `new_vals` must be named.")
     }
     if (is.null(x)) {
       x <- list()
@@ -190,7 +207,7 @@ list2DF <- function(x = list(), nrow = 0L) {
   stopifnot(is.list(x), is.null(nrow) || nrow >= 0L)
   if (n <- length(x)) {
     if (length(nrow <- unique(lengths(x))) > 1L) {
-      stop("All variables should have the same length.", call. = FALSE)
+      stop2("All variables should have the same length.")
     }
   } else {
     if (is.null(nrow)) {
diff --git a/R/valid.R b/R/valid.R
index 5b1f5468..e3766e53 100644
--- a/R/valid.R
+++ b/R/valid.R
@@ -67,11 +67,21 @@ validate <- function(object, recursive = TRUE, properties = TRUE) {
   check_is_S7(object)
 
   parent <- if (!recursive) S7_class(object)@parent
-  validate_from(object, parent = parent, properties = properties)
+  validate_from(
+    object,
+    parent = parent,
+    properties = properties,
+    call = sys.call()
+  )
 }
 
 # validates `object` assuming `parent` (if supplied) has been validated
-validate_from <- function(object, parent = NULL, properties = TRUE) {
+validate_from <- function(
+  object,
+  parent = NULL,
+  properties = TRUE,
+  call = sys.call(-1L)
+) {
   if (!is.null(attr(object, ".should_validate"))) {
     return(invisible(object))
   }
@@ -89,11 +99,7 @@ validate_from <- function(object, parent = NULL, properties = TRUE) {
         obj_desc(object),
         bullets
       )
-      stop(errorCondition(
-        msg,
-        call = NULL,
-        class = "S7_error_validation_failed"
-      ))
+      stop2(msg, call = call, class = "S7_error_validation_failed")
     }
   }
 
@@ -104,11 +110,14 @@ validate_from <- function(object, parent = NULL, properties = TRUE) {
     if (is.null(error)) {} else if (is.character(error)) {
       append(errors) <- error
     } else {
-      stop(sprintf(
-        "%s validator must return NULL or a character, not <%s>.",
-        obj_desc(class),
-        typeof(error)
-      ))
+      stop2(
+        sprintf(
+          "%s validator must return NULL or a character, not <%s>.",
+          obj_desc(class),
+          typeof(error)
+        ),
+        call = call
+      )
     }
     if (!is_class(class) || identical(class@parent, parent)) {
       break
@@ -120,7 +129,7 @@ validate_from <- function(object, parent = NULL, properties = TRUE) {
   if (length(errors) > 0) {
     bullets <- paste0("- ", errors, collapse = "\n")
     msg <- sprintf("%s object is invalid:\n%s", obj_desc(object), bullets)
-    stop(errorCondition(msg, call = NULL, class = "S7_error_validation_failed"))
+    stop2(msg, call = call, class = "S7_error_validation_failed")
   }
 
   invisible(object)
diff --git a/R/zzz.R b/R/zzz.R
index 67b94324..5b9bc2fe 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -42,7 +42,7 @@ is_S7_type <- function(x) {
       deparse1(substitute(x)),
       name
     )
-    stop(msg)
+    stop2(msg)
   }
 }
 #' @export
@@ -55,7 +55,7 @@ is_S7_type <- function(x) {
       name,
       deparse1(substitute(value))
     )
-    stop(msg)
+    stop2(msg)
   }
 }
 
@@ -81,7 +81,7 @@ is_S7_type <- function(x) {
   NextMethod()
 }
 
-check_subsettable <- function(x, allow_env = FALSE) {
+check_subsettable <- function(x, allow_env = FALSE, call = sys.call(-1L)) {
   allowed_types <- c(
     "list",
     "language",
@@ -89,7 +89,7 @@ check_subsettable <- function(x, allow_env = FALSE) {
     if (allow_env) "environment"
   )
   if (!typeof(x) %in% allowed_types) {
-    stop("S7 objects are not subsettable.", call. = FALSE)
+    stop2("S7 objects are not subsettable.", call = call)
   }
   invisible(TRUE)
 }
diff --git a/man/S7_inherits.Rd b/man/S7_inherits.Rd
index 6fd00560..27556de3 100644
--- a/man/S7_inherits.Rd
+++ b/man/S7_inherits.Rd
@@ -7,7 +7,12 @@
 \usage{
 S7_inherits(x, class = NULL)
 
-check_is_S7(x, class = NULL, arg = deparse(substitute(x)))
+check_is_S7(
+  x,
+  class = NULL,
+  arg = deparse(substitute(x)),
+  call = sys.call(-1L)
+)
 }
 \arguments{
 \item{x}{An object.}
@@ -18,6 +23,9 @@ an S7 class, S7 union, S3 class, S4 class, base type wrapper like
 whether \code{x} is an S7 object, without testing for a specific class.}
 
 \item{arg}{Argument name used in error message.}
+
+\item{call}{The call to report in the error message. Defaults to the
+calling function.}
 }
 \value{
 \itemize{
diff --git a/man/as_class.Rd b/man/as_class.Rd
index 9864f4a3..08640ed3 100644
--- a/man/as_class.Rd
+++ b/man/as_class.Rd
@@ -32,4 +32,4 @@ formal S4 classes.
 as_class(class_logical)
 as_class(new_S3_class("factor"))
 }
-\keyword{internal}
+\keyword{interna}
diff --git a/man/super.Rd b/man/super.Rd
index 7698b9ae..16d0de9d 100644
--- a/man/super.Rd
+++ b/man/super.Rd
@@ -44,18 +44,17 @@ understand and reason about.
 Note that you can't use \code{super()} in methods for an S3 generic.
 For example, imagine that you have made a subclass of "integer":
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{MyInt <- new_class("MyInt", parent = class_integer, package = NULL)
+\if{html}{\out{<div class="sourceCode {r}">}}\preformatted{MyInt <- new_class("MyInt", parent = class_integer, package = NULL)
 }\if{html}{\out{</div>}}
 
 Now you go to write a custom print method:
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
+\if{html}{\out{<div class="sourceCode {r}">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
    cat("<MyInt>")
    print(super(x, to = class_integer))
 \}
 
 MyInt(10L)
-#> <MyInt>super(<MyInt>, <integer>)
 }\if{html}{\out{</div>}}
 
 This doesn't work because \code{print()} isn't an S7 generic so doesn't
@@ -64,13 +63,12 @@ While you could resolve this problem with \code{\link[=NextMethod]{NextMethod()}
 implemented on top of S3), we instead recommend using \code{\link[=S7_data]{S7_data()}} to extract
 the underlying base object:
 
-\if{html}{\out{<div class="sourceCode r">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
+\if{html}{\out{<div class="sourceCode {r}">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
    cat("<MyInt>")
    print(S7_data(x))
 \}
 
 MyInt(10L)
-#> <MyInt>[1] 10
 }\if{html}{\out{</div>}}
 }
 }
diff --git a/tests/testthat/_snaps/S3.md b/tests/testthat/_snaps/S3.md
index 065dd283..b57ba962 100644
--- a/tests/testthat/_snaps/S3.md
+++ b/tests/testthat/_snaps/S3.md
@@ -10,7 +10,7 @@
     Code
       foo2("a")
     Condition
-      Error:
+      Error in `foo2()`:
       ! <foo2> object is invalid:
       - Underlying data must be a double
 
@@ -27,12 +27,12 @@
     Code
       new_S3_class("foo", function(x) { })
     Condition
-      Error:
+      Error in `new_S3_class()`:
       ! First argument to `constructor` must be .data.
     Code
       new_S3_class("foo", function(.data, ...) { })
     Condition
-      Error:
+      Error in `new_S3_class()`:
       ! `constructor` can not use `...`.
 
 # default new_S3_class constructor errors
diff --git a/tests/testthat/_snaps/S4.md b/tests/testthat/_snaps/S4.md
index 7c3bf932..e3aaa81a 100644
--- a/tests/testthat/_snaps/S4.md
+++ b/tests/testthat/_snaps/S4.md
@@ -3,12 +3,12 @@
     Code
       S4_register(1)
     Condition
-      Error:
+      Error in `S4_register()`:
       ! `class` must be an S7 class or an S3 class, not a <double>.
     Code
       S4_register("foo")
     Condition
-      Error:
+      Error in `S4_register()`:
       ! `class` must be an S7 class or an S3 class, not a <character>.
 
 # errors on non-S4 classes
diff --git a/tests/testthat/_snaps/base-environment.md b/tests/testthat/_snaps/base-environment.md
index 2ec61ea1..afffa7e0 100644
--- a/tests/testthat/_snaps/base-environment.md
+++ b/tests/testthat/_snaps/base-environment.md
@@ -3,13 +3,13 @@
     Code
       S7_data(e)
     Condition
-      Error:
+      Error in `S7_data()`:
       ! Can't call `S7_data()` on an environment.
       See ?class_environment for details.
     Code
       S7_data(e) <- new.env()
     Condition
-      Error:
+      Error in `S7_data<-`:
       ! Can't call `S7_data<-` on an environment.
       See ?class_environment for details.
 
@@ -31,7 +31,7 @@
     Code
       convert(Child(), Parent)
     Condition
-      Error:
+      Error in `convert()`:
       ! Can't call `convert()` on an environment.
       See ?class_environment for details.
 
diff --git a/tests/testthat/_snaps/class.md b/tests/testthat/_snaps/class.md
index bb8818cc..e6c19d8c 100644
--- a/tests/testthat/_snaps/class.md
+++ b/tests/testthat/_snaps/class.md
@@ -57,7 +57,7 @@
     Code
       new_class(1)
     Condition
-      Error:
+      Error in `new_class()`:
       ! `name` must be a single string.
     Code
       new_class("foo", 1)
@@ -72,22 +72,22 @@
     Code
       new_class("foo", package = 1)
     Condition
-      Error:
+      Error in `new_class()`:
       ! `package` must be a single string.
     Code
       new_class("foo", constructor = 1)
     Condition
-      Error:
+      Error in `new_class()`:
       ! `constructor` must be a function.
     Code
       new_class("foo", constructor = function() { })
     Condition
-      Error:
+      Error in `new_class()`:
       ! `constructor` must contain a call to `new_object()`.
     Code
       new_class("foo", validator = function() { })
     Condition
-      Error:
+      Error in `new_class()`:
       ! `validator` must be function(self), not function().
 
 # S7 classes / can't inherit from S4 or class unions
@@ -95,13 +95,13 @@
     Code
       new_class("test", parent = parentS4)
     Condition
-      Error:
+      Error in `new_class()`:
       ! `parent` must be an S7 class, S3 class, or base type, not an S4 class.
     Code
       new_class("test", parent = new_union("character"))
     Condition
-      Error in `FUN()`:
-      ! Can't convert `X[[i]]` to a valid class.
+      Error in `as_class()`:
+      ! Can't convert `..1` to a valid class.
       Class specification must be one of the following, not a <character>:
        * An S7 class object
        * An S3 class object (from `new_S3_class()`)
@@ -131,7 +131,7 @@
     Code
       foo2(x = 2)
     Condition
-      Error:
+      Error in `foo2()`:
       ! <foo2> object is invalid:
       - @x has bad value
 
@@ -148,12 +148,12 @@
     Code
       Foo()
     Condition
-      Error:
+      Error in `new_object()`:
       ! `.parent` must be an instance of <Bar>, not S3<S7_base_class>.
     Code
       Baz()
     Condition
-      Error:
+      Error in `new_object()`:
       ! `.parent` must be an instance of <integer>, not <character>.
 
 # new_object() / errors if `.parent` is supplied but class has no parent
@@ -161,7 +161,7 @@
     Code
       NoParent()
     Condition
-      Error:
+      Error in `new_object()`:
       ! `.parent` must not be supplied when class has no parent.
 
 # new_object() / validates object
@@ -169,13 +169,13 @@
     Code
       foo("x")
     Condition
-      Error:
+      Error in `foo()`:
       ! <foo> object properties are invalid:
       - @x must be <double>, not <character>
     Code
       foo(-1)
     Condition
-      Error:
+      Error in `foo()`:
       ! <foo> object is invalid:
       - x must be positive
 
diff --git a/tests/testthat/_snaps/generic.md b/tests/testthat/_snaps/generic.md
index dae65d7e..bc4b75f0 100644
--- a/tests/testthat/_snaps/generic.md
+++ b/tests/testthat/_snaps/generic.md
@@ -3,22 +3,22 @@
     Code
       new_generic(1)
     Condition
-      Error:
+      Error in `new_generic()`:
       ! `name` must be a single string.
     Code
       new_generic("")
     Condition
-      Error:
+      Error in `new_generic()`:
       ! `name` must not be "" or NA.
     Code
       new_generic("foo", 1)
     Condition
-      Error:
+      Error in `new_generic()`:
       ! `dispatch_args` must be a character vector.
     Code
       new_generic("foo", "x", function(x) { })
     Condition
-      Error:
+      Error in `new_generic()`:
       ! `fun` must contain a call to `S7_dispatch()`.
 
 # check_dispatch_args() produces informative errors
diff --git a/tests/testthat/_snaps/method-introspect.md b/tests/testthat/_snaps/method-introspect.md
index 03c974dc..eb462803 100644
--- a/tests/testthat/_snaps/method-introspect.md
+++ b/tests/testthat/_snaps/method-introspect.md
@@ -3,13 +3,13 @@
     Code
       method(print, 1)
     Condition
-      Error:
+      Error in `method()`:
       ! `generic` must be a <S7_generic>, not a <closure>.
     Code
       foo <- new_generic("foo", "x")
       method(foo)
     Condition
-      Error:
+      Error in `method()`:
       ! Must supply exactly one of `class` and `object`.
     Code
       method(foo, 1)
@@ -24,13 +24,13 @@
     Code
       method(foo, new_union(class_integer, class_double))
     Condition
-      Error:
+      Error in `method()`:
       ! Can't dispatch on unions; must be a concrete type.
     Code
       foo2 <- new_generic("foo2", c("x", "y"))
       method(foo2, object = list(class_character))
     Condition
-      Error:
+      Error in `method()`:
       ! `object` must be length 2.
 
 # method introspection / errors if no method found
diff --git a/tests/testthat/_snaps/method-register.md b/tests/testthat/_snaps/method-register.md
index 0e65ede4..08198409 100644
--- a/tests/testthat/_snaps/method-register.md
+++ b/tests/testthat/_snaps/method-register.md
@@ -11,7 +11,7 @@
     Code
       method(sum, new_S3_class("foo")) <- (function(x, ...) "foo")
     Condition
-      Error:
+      Error in `method<-`:
       ! When registering methods for S3 generic sum(), signature must be an S7 class, not an S3 class.
 
 # method registration / can register S7 method for S4 generic
@@ -24,7 +24,7 @@
       x <- 10
       method(x, class_character) <- (function(x) ...)
     Condition
-      Error:
+      Error in `method<-`:
       ! `generic` must be a function, not a <double>.
     Code
       method(foo, 1) <- (function(x) ...)
@@ -60,7 +60,7 @@
     Code
       method(sum, foo) <- NULL
     Condition
-      Error:
+      Error in `method<-`:
       ! Can't unregister methods for S3 generics
 
 ---
@@ -68,7 +68,7 @@
     Code
       method(base_sum, foo) <- NULL
     Condition
-      Error:
+      Error in `method<-`:
       ! Can't unregister methods for S3 generics
 
 # method unregistration / errors when unregistering from an S4 generic
@@ -76,7 +76,7 @@
     Code
       method(removeS4, S4foo) <- NULL
     Condition
-      Error:
+      Error in `method<-`:
       ! Can't unregister methods for S4 generics
 
 # as_signature() / accepts a length-1 list for single dispatch (#555)
diff --git a/tests/testthat/_snaps/property.md b/tests/testthat/_snaps/property.md
index ad9510d3..bbb0ce25 100644
--- a/tests/testthat/_snaps/property.md
+++ b/tests/testthat/_snaps/property.md
@@ -42,7 +42,7 @@
     Code
       validate(obj)
     Condition
-      Error:
+      Error in `validate()`:
       ! <S7::foo> object is invalid:
       - bad
 
@@ -51,7 +51,7 @@
     Code
       validate(obj2)
     Condition
-      Error:
+      Error in `validate()`:
       ! <S7::foo> object is invalid:
       - bad
 
@@ -60,12 +60,12 @@
     Code
       new_property(getter = function(x) { })
     Condition
-      Error:
+      Error in `new_property()`:
       ! `getter` must be function(self), not function(x).
     Code
       new_property(setter = function(x, y, z) { })
     Condition
-      Error:
+      Error in `new_property()`:
       ! `setter` must be function(self, value) or function(self, name, value), not function(x, y, z).
 
 # new_property() / validates default
@@ -195,7 +195,7 @@
     Code
       foo(x = 1:2)
     Condition
-      Error:
+      Error in `foo()`:
       ! <foo> object properties are invalid:
       - @x must be length 1
 
diff --git a/tests/testthat/_snaps/super.md b/tests/testthat/_snaps/super.md
index 7336cb57..c158ac7c 100644
--- a/tests/testthat/_snaps/super.md
+++ b/tests/testthat/_snaps/super.md
@@ -9,12 +9,12 @@
     Code
       super(foo(), class_numeric)
     Condition
-      Error:
+      Error in `super()`:
       ! `to` must be an S7, S3, S4, or base class, not an S7 union.
     Code
       super(foo(), NULL)
     Condition
-      Error:
+      Error in `super()`:
       ! `to` must be an S7, S3, S4, or base class, not NULL.
 
 # super() / displays nicely
diff --git a/tests/testthat/_snaps/valid.md b/tests/testthat/_snaps/valid.md
index 9fd61e01..6127dc94 100644
--- a/tests/testthat/_snaps/valid.md
+++ b/tests/testthat/_snaps/valid.md
@@ -5,14 +5,14 @@
       attr(obj, "x") <- -1
       validate(obj)
     Condition
-      Error:
+      Error in `validate()`:
       ! <klass> object is invalid:
       - x must be positive
     Code
       attr(obj, "x") <- "y"
       validate(obj)
     Condition
-      Error:
+      Error in `validate()`:
       ! <klass> object properties are invalid:
       - @x must be <double>, not <character>
 
@@ -23,7 +23,7 @@
       attr(obj, "x") <- -1
       validate(obj)
     Condition
-      Error:
+      Error in `validate()`:
       ! <klass2> object is invalid:
       - x must be positive
     Code
@@ -31,7 +31,7 @@
       attr(obj, "z") <- "y"
       validate(obj)
     Condition
-      Error:
+      Error in `validate()`:
       ! <klass2> object properties are invalid:
       - @x must be <double>, not <character>
       - @z must be <double>, not <character>
@@ -41,7 +41,7 @@
     Code
       validate(x)
     Condition
-      Error:
+      Error in `validate()`:
       ! <Double> object is invalid:
       - Underlying data must be <double> not <character>
 
diff --git a/tests/testthat/_snaps/zzz.md b/tests/testthat/_snaps/zzz.md
index 301890a9..985bb56c 100644
--- a/tests/testthat/_snaps/zzz.md
+++ b/tests/testthat/_snaps/zzz.md
@@ -22,12 +22,12 @@
       x <- new_class("foo")()
       x[1]
     Condition
-      Error:
+      Error in `[.S7_object`:
       ! S7 objects are not subsettable.
     Code
       x[1] <- 1
     Condition
-      Error:
+      Error in `[<-.S7_object`:
       ! S7 objects are not subsettable.
 
 # [[ gives more accurate error
@@ -36,11 +36,11 @@
       x <- new_class("foo")()
       x[[1]]
     Condition
-      Error:
+      Error in `[[.S7_object`:
       ! S7 objects are not subsettable.
     Code
       x[[1]] <- 1
     Condition
-      Error:
+      Error in `[[<-.S7_object`:
       ! S7 objects are not subsettable.
 

From 17cbdfdaa03a89e9d89055a4b11efc40c08af179 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 29 May 2026 12:30:48 -0500
Subject: [PATCH 2/2] Fix typo

---
 R/class-spec.R  | 2 +-
 man/as_class.Rd | 2 +-
 man/super.Rd    | 8 +++++---
 3 files changed, 7 insertions(+), 5 deletions(-)

diff --git a/R/class-spec.R b/R/class-spec.R
index 6075b79a..a74c03a8 100644
--- a/R/class-spec.R
+++ b/R/class-spec.R
@@ -12,7 +12,7 @@
 #'   * A base class, like [class_logical], [class_integer], or [class_double].
 #'   * A "special", either [class_missing] or [class_any].
 #' @param arg Argument name used when generating errors.
-#' @keywords interna
+#' @keywords internal
 #' @export
 #' @return A standardised class: either `NULL`, an S7 class, an S7 union,
 #'   as [new_S3_class], or a S4 class.
diff --git a/man/as_class.Rd b/man/as_class.Rd
index 08640ed3..9864f4a3 100644
--- a/man/as_class.Rd
+++ b/man/as_class.Rd
@@ -32,4 +32,4 @@ formal S4 classes.
 as_class(class_logical)
 as_class(new_S3_class("factor"))
 }
-\keyword{interna}
+\keyword{internal}
diff --git a/man/super.Rd b/man/super.Rd
index 16d0de9d..7698b9ae 100644
--- a/man/super.Rd
+++ b/man/super.Rd
@@ -44,17 +44,18 @@ understand and reason about.
 Note that you can't use \code{super()} in methods for an S3 generic.
 For example, imagine that you have made a subclass of "integer":
 
-\if{html}{\out{<div class="sourceCode {r}">}}\preformatted{MyInt <- new_class("MyInt", parent = class_integer, package = NULL)
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{MyInt <- new_class("MyInt", parent = class_integer, package = NULL)
 }\if{html}{\out{</div>}}
 
 Now you go to write a custom print method:
 
-\if{html}{\out{<div class="sourceCode {r}">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
    cat("<MyInt>")
    print(super(x, to = class_integer))
 \}
 
 MyInt(10L)
+#> <MyInt>super(<MyInt>, <integer>)
 }\if{html}{\out{</div>}}
 
 This doesn't work because \code{print()} isn't an S7 generic so doesn't
@@ -63,12 +64,13 @@ While you could resolve this problem with \code{\link[=NextMethod]{NextMethod()}
 implemented on top of S3), we instead recommend using \code{\link[=S7_data]{S7_data()}} to extract
 the underlying base object:
 
-\if{html}{\out{<div class="sourceCode {r}">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
+\if{html}{\out{<div class="sourceCode r">}}\preformatted{method(print, MyInt) <- function(x, ...) \{
    cat("<MyInt>")
    print(S7_data(x))
 \}
 
 MyInt(10L)
+#> <MyInt>[1] 10
 }\if{html}{\out{</div>}}
 }
 }