Skip to content

Fix S4 method dispatch on imported S3 generics (e.g. setMethod("as.data.table", "Basket", ...)) #8

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
Copilot wants to merge 4 commits into
base: main
Choose a base branch
from
+113 −6
Draft

Fix S4 method dispatch on imported S3 generics (e.g. setMethod("as.data.table", "Basket", ...)) #8

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
d53131e
fix: S4 method dispatch on imported S3 generics in load_fast()
Copilot Apr 9, 2026
e1d67be
test: expand Basket/as.data.table coverage per review feedback
Copilot Apr 10, 2026
dcc3a12
fix: remove exportMethods(as.data.table) from devpackage NAMESPACE; u…
Copilot Apr 10, 2026
387678b
test: add implicit generic checks in Stage 4b incremental reload
Copilot Apr 10, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 6 additions & 5 deletions R/loadfast.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -186,8 +186,8 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full =
}
.timer(paste0("incr source ", length(files_to_source), " files"))

list2env(as.list(ns_env, all.names = FALSE), envir = pkg_env)
list2env(as.list(parent.env(ns_env), all.names = TRUE), envir = pkg_env)
list2env(as.list(ns_env, all.names = FALSE), envir = pkg_env)
.timer("incr pkg_env sync")

.loadfast.cache[[abs_path]] <- list(
Expand Down Expand Up @@ -379,9 +379,10 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full =
.timer(paste0("source ", length(r_files), " files"))

if (file.exists(ns_file)) {
exports <- nsInfo$exports
if (length(exports) > 0L) {
namespaceExport(ns_env, exports)
all_exports <- unique(c(nsInfo$exports, nsInfo$exportMethods, nsInfo$exportClasses))
all_exports <- all_exports[nzchar(all_exports)]
if (length(all_exports) > 0L) {
namespaceExport(ns_env, all_exports)
}
}

Expand All @@ -399,8 +400,8 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full =
.timer("attach testthat")

pkg_env <- attach(NULL, name = pkg_env_name)
list2env(as.list(ns_env, all.names = FALSE), envir = pkg_env)
list2env(as.list(impenv, all.names = TRUE), envir = pkg_env)
list2env(as.list(ns_env, all.names = FALSE), envir = pkg_env)
.timer("attach pkg to search path")

if (isTRUE(helpers) && uses_testthat) {
Expand Down
1 change: 1 addition & 0 deletions devpackage/NAMESPACE
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,3 +4,4 @@ importFrom(R6, R6Class)
importFrom(data.table,":=")
importFrom(data.table,as.data.table)
importFrom(data.table,data.table)
exportMethods(as.data.table)

@felix-andreas-finccam felix-andreas-finccam Apr 10, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@copilot remove this. we shouldn't export this method. we only import it. we shouldn't rely on an export

Copilot AI Apr 10, 2026

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Done in dcc3a12. Removed exportMethods(as.data.table) from devpackage/NAMESPACE. The export test now asserts that as.data.table is not in getNamespaceExports("devpackage"), and all direct-call tests were updated from getExportedValue() (which requires export) to get("as.data.table", pos = "package:devpackage") (search-path lookup).

9 changes: 8 additions & 1 deletion devpackage/R/s4_classes.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,4 +45,11 @@ animal <- function(name, species, legs) {

pet <- function(name, species, legs, owner) {
new("Pet", name = name, species = species, legs = legs, owner = owner)
}
}

# --- Class: Basket (for testing setMethod on an imported S3 generic) ---
setClass("Basket", representation(contents = "character"))

setMethod("as.data.table", "Basket", function(x, keep.rownames = FALSE, ...) {
data.table(item = x@contents)
})
39 changes: 39 additions & 0 deletions test_loadfast.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -441,6 +441,38 @@ check("testthat devpackage: all tests pass", quote(

cat(sprintf(" (testthat devpackage: %d passed, %d failed)\n", n_tt_pass1, n_tt_fail1))

# --- S4 method on imported S3 generic (as.data.table) ---
b1 <- new("Basket", contents = c("apple", "pear"))

check("Basket class is defined", quote(
isClass("Basket")
))

check("as.data.table implicit generic is in ns_env (not just the imported S3 fn)", quote(
is(get("as.data.table", envir = ns, inherits = FALSE), "genericFunction")
))

check("as.data.table in pkg_env is the implicit generic (not overwritten by impenv)", quote(
is(get("as.data.table", pos = "package:devpackage", inherits = FALSE), "genericFunction")
))

check("as.data.table(Basket) dispatches correctly from ns_env", quote({
f <- get("as.data.table", envir = ns)
dt <- f(b1)
data.table::is.data.table(dt) && identical(dt$item, c("apple", "pear"))
}))

check("as.data.table(Basket) dispatches correctly via search path", quote({
f <- get("as.data.table", pos = "package:devpackage")
dt <- f(b1)
data.table::is.data.table(dt) && identical(dt$item, c("apple", "pear"))
}))

check("exportMethods: as.data.table is in namespace exports", quote(
"as.data.table" %in% getNamespaceExports("devpackage")
))


@felix-andreas-finccam felix-andreas-finccam Apr 10, 2026

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@copilot can we also test if normal call works? also for incmrental test. are these new tests exhaustive? can you think of more

basket <- new("Basket", ...)
as.data.table(new()

Copilot AI Apr 10, 2026

Copy link
Copy Markdown
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Added in e1d67be. Both Stage 1 (full load) and Stage 4b (incremental) now cover:

  • existsMethod("as.data.table", "Basket") — method is registered
  • Direct call via getExportedValue("devpackage", "as.data.table")(basket) — no get() wrapper
  • Direct call via evalq(as.data.table(basket), envir = as.environment("package:devpackage")) — natural call syntax in pkg_env scope
  • Single-element Basket
  • Empty Basket → 0-row DT with item column
  • Non-Basket data.frame dispatch still works (regression guard)

# ============================================================================
# STAGE 2: Full reload with mutated code (project2-style changes, ad-hoc)
# ============================================================================
Expand Down Expand Up @@ -1469,6 +1501,13 @@ check("remove-fn: R6 classes unaffected", quote(
exists("Counter", envir = ns4b, inherits = FALSE)
))

check("incr-reload: Basket method still works via pkg_env after base.R changed", quote({
b_incr <- new("Basket", contents = c("x", "y"))
f <- get("as.data.table", pos = pkg_env4)
dt <- f(b_incr)
data.table::is.data.table(dt) && identical(dt$item, c("x", "y"))
}))

ns4b_full <- load_fast(tmp_c, helpers = FALSE, attach_testthat = FALSE, full = TRUE)

check("remove-fn: full=TRUE clears summarize_values from ns", quote(
Expand Down
Loading