From d53131e1f2ae19b5d0ddee77b8e5c4e5e992920b Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Thu, 9 Apr 2026 11:46:38 +0000 Subject: [PATCH 1/4] fix: S4 method dispatch on imported S3 generics in load_fast() - Reverse pkg_env copy order in full load (impenv first, ns_env second) so implicit generics created by setMethod() are not overwritten by the original imported function from impenv - Same fix in incremental load path - Process nsInfo$exportMethods and nsInfo$exportClasses when calling namespaceExport(), so exportMethods() directives in NAMESPACE are honoured - Add Basket class + setMethod("as.data.table","Basket") to devpackage fixture - Add exportMethods(as.data.table) to devpackage/NAMESPACE - Add Stage 1 tests covering implicit generic in ns_env and pkg_env, search-path dispatch, and namespace exports - Add Stage 4b incremental reload test for Basket method via pkg_env Agent-Logs-Url: https://github.com/finccam/loadfast/sessions/1e692b27-bdbc-40af-987c-8cde7d9c14cd Co-authored-by: felix-andreas-finccam <266759557+felix-andreas-finccam@users.noreply.github.com> --- R/loadfast.R | 11 ++++++----- devpackage/NAMESPACE | 1 + devpackage/R/s4_classes.R | 9 ++++++++- test_loadfast.R | 39 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 54 insertions(+), 6 deletions(-) diff --git a/R/loadfast.R b/R/loadfast.R index 5f9255f..48c07a3 100644 --- a/R/loadfast.R +++ b/R/loadfast.R @@ -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( @@ -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) } } @@ -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) { diff --git a/devpackage/NAMESPACE b/devpackage/NAMESPACE index cf20777..04a7b00 100644 --- a/devpackage/NAMESPACE +++ b/devpackage/NAMESPACE @@ -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) diff --git a/devpackage/R/s4_classes.R b/devpackage/R/s4_classes.R index d8dec16..e8a327e 100644 --- a/devpackage/R/s4_classes.R +++ b/devpackage/R/s4_classes.R @@ -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) -} \ No newline at end of file +} + +# --- 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) +}) \ No newline at end of file diff --git a/test_loadfast.R b/test_loadfast.R index 1b02b21..92f174a 100644 --- a/test_loadfast.R +++ b/test_loadfast.R @@ -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") +)) + + # ============================================================================ # STAGE 2: Full reload with mutated code (project2-style changes, ad-hoc) # ============================================================================ @@ -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( From e1d67be998b5280713d36f6234850f042e16ef40 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Fri, 10 Apr 2026 07:15:05 +0000 Subject: [PATCH 2/4] test: expand Basket/as.data.table coverage per review feedback MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Stage 1 additions: - existsMethod("as.data.table", "Basket") registration check - Direct call via getExportedValue("devpackage", "as.data.table")(b1) - Direct call via evalq(as.data.table(b1), envir = pkg_env) - Single-element Basket edge case - Empty Basket → 0-row DT edge case - Non-Basket data.frame dispatch regression test Stage 4b additions (incremental path): - existsMethod() still true after reload - Direct call via getExportedValue() after reload - Direct call via evalq in pkg_env scope after reload - Empty Basket edge case after reload Agent-Logs-Url: https://github.com/finccam/loadfast/sessions/b04d79a4-ae26-4d2c-8d17-24aaa4c3ee10 Co-authored-by: felix-andreas-finccam <266759557+felix-andreas-finccam@users.noreply.github.com> --- test_loadfast.R | 60 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 56 insertions(+), 4 deletions(-) diff --git a/test_loadfast.R b/test_loadfast.R index 92f174a..7dcfe50 100644 --- a/test_loadfast.R +++ b/test_loadfast.R @@ -442,12 +442,18 @@ 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")) +b1 <- new("Basket", contents = c("apple", "pear")) +b1_single <- new("Basket", contents = "only") +b1_empty <- new("Basket", contents = character(0)) check("Basket class is defined", quote( isClass("Basket") )) +check("as.data.table method is registered for Basket", quote( + existsMethod("as.data.table", "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") )) @@ -456,6 +462,10 @@ check("as.data.table in pkg_env is the implicit generic (not overwritten by impe is(get("as.data.table", pos = "package:devpackage", inherits = FALSE), "genericFunction") )) +check("exportMethods: as.data.table is in namespace exports", quote( + "as.data.table" %in% getNamespaceExports("devpackage") +)) + check("as.data.table(Basket) dispatches correctly from ns_env", quote({ f <- get("as.data.table", envir = ns) dt <- f(b1) @@ -468,9 +478,30 @@ check("as.data.table(Basket) dispatches correctly via search path", quote({ 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") -)) +check("as.data.table(Basket) direct call via getExportedValue", quote({ + dt <- getExportedValue("devpackage", "as.data.table")(b1) + data.table::is.data.table(dt) && identical(dt$item, c("apple", "pear")) +})) + +check("as.data.table(Basket) direct call evaluated in pkg_env scope", quote({ + dt <- evalq(as.data.table(b1), envir = as.environment("package:devpackage")) + data.table::is.data.table(dt) && identical(dt$item, c("apple", "pear")) +})) + +check("as.data.table(Basket) single-element Basket", quote({ + dt <- getExportedValue("devpackage", "as.data.table")(b1_single) + data.table::is.data.table(dt) && nrow(dt) == 1L && identical(dt$item, "only") +})) + +check("as.data.table(Basket) empty Basket yields 0-row DT with item column", quote({ + dt <- getExportedValue("devpackage", "as.data.table")(b1_empty) + data.table::is.data.table(dt) && nrow(dt) == 0L && identical(names(dt), "item") +})) + +check("as.data.table on data.frame still works (non-Basket dispatch unaffected)", quote({ + dt <- data.table::as.data.table(data.frame(x = 1:2, y = c("a", "b"), stringsAsFactors = FALSE)) + data.table::is.data.table(dt) && identical(dt$x, 1:2) +})) # ============================================================================ @@ -1501,6 +1532,10 @@ check("remove-fn: R6 classes unaffected", quote( exists("Counter", envir = ns4b, inherits = FALSE) )) +check("incr-reload: Basket method still registered after base.R changed", quote( + existsMethod("as.data.table", "Basket") +)) + 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) @@ -1508,6 +1543,23 @@ check("incr-reload: Basket method still works via pkg_env after base.R changed", data.table::is.data.table(dt) && identical(dt$item, c("x", "y")) })) +check("incr-reload: Basket direct call via getExportedValue after reload", quote({ + b_incr2 <- new("Basket", contents = c("x", "y")) + dt <- getExportedValue("devpackage", "as.data.table")(b_incr2) + data.table::is.data.table(dt) && identical(dt$item, c("x", "y")) +})) + +check("incr-reload: Basket direct call evaluated in pkg_env scope after reload", quote({ + b_incr3 <- new("Basket", contents = c("x", "y")) + dt <- evalq(as.data.table(b_incr3), envir = as.environment("package:devpackage")) + data.table::is.data.table(dt) && identical(dt$item, c("x", "y")) +})) + +check("incr-reload: empty Basket yields 0-row DT after reload", quote({ + dt <- getExportedValue("devpackage", "as.data.table")(new("Basket", contents = character(0))) + data.table::is.data.table(dt) && nrow(dt) == 0L && identical(names(dt), "item") +})) + ns4b_full <- load_fast(tmp_c, helpers = FALSE, attach_testthat = FALSE, full = TRUE) check("remove-fn: full=TRUE clears summarize_values from ns", quote( From dcc3a12ada17bab9a06b94a47467f38a48e8d838 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Fri, 10 Apr 2026 07:21:07 +0000 Subject: [PATCH 3/4] fix: remove exportMethods(as.data.table) from devpackage NAMESPACE; update tests accordingly Agent-Logs-Url: https://github.com/finccam/loadfast/sessions/867ce387-0440-413c-a48f-d463aca793c4 Co-authored-by: felix-andreas-finccam <266759557+felix-andreas-finccam@users.noreply.github.com> --- devpackage/NAMESPACE | 1 - test_loadfast.R | 18 +++++++++--------- 2 files changed, 9 insertions(+), 10 deletions(-) diff --git a/devpackage/NAMESPACE b/devpackage/NAMESPACE index 04a7b00..cf20777 100644 --- a/devpackage/NAMESPACE +++ b/devpackage/NAMESPACE @@ -4,4 +4,3 @@ importFrom(R6, R6Class) importFrom(data.table,":=") importFrom(data.table,as.data.table) importFrom(data.table,data.table) -exportMethods(as.data.table) diff --git a/test_loadfast.R b/test_loadfast.R index 7dcfe50..39f876b 100644 --- a/test_loadfast.R +++ b/test_loadfast.R @@ -462,8 +462,8 @@ check("as.data.table in pkg_env is the implicit generic (not overwritten by impe is(get("as.data.table", pos = "package:devpackage", inherits = FALSE), "genericFunction") )) -check("exportMethods: as.data.table is in namespace exports", quote( - "as.data.table" %in% getNamespaceExports("devpackage") +check("as.data.table not in namespace exports (no exportMethods directive)", quote( + !"as.data.table" %in% getNamespaceExports("devpackage") )) check("as.data.table(Basket) dispatches correctly from ns_env", quote({ @@ -478,8 +478,8 @@ check("as.data.table(Basket) dispatches correctly via search path", quote({ data.table::is.data.table(dt) && identical(dt$item, c("apple", "pear")) })) -check("as.data.table(Basket) direct call via getExportedValue", quote({ - dt <- getExportedValue("devpackage", "as.data.table")(b1) +check("as.data.table(Basket) direct call via pkg_env", quote({ + dt <- get("as.data.table", pos = "package:devpackage")(b1) data.table::is.data.table(dt) && identical(dt$item, c("apple", "pear")) })) @@ -489,12 +489,12 @@ check("as.data.table(Basket) direct call evaluated in pkg_env scope", quote({ })) check("as.data.table(Basket) single-element Basket", quote({ - dt <- getExportedValue("devpackage", "as.data.table")(b1_single) + dt <- get("as.data.table", pos = "package:devpackage")(b1_single) data.table::is.data.table(dt) && nrow(dt) == 1L && identical(dt$item, "only") })) check("as.data.table(Basket) empty Basket yields 0-row DT with item column", quote({ - dt <- getExportedValue("devpackage", "as.data.table")(b1_empty) + dt <- get("as.data.table", pos = "package:devpackage")(b1_empty) data.table::is.data.table(dt) && nrow(dt) == 0L && identical(names(dt), "item") })) @@ -1543,9 +1543,9 @@ check("incr-reload: Basket method still works via pkg_env after base.R changed", data.table::is.data.table(dt) && identical(dt$item, c("x", "y")) })) -check("incr-reload: Basket direct call via getExportedValue after reload", quote({ +check("incr-reload: Basket direct call via pkg_env after reload", quote({ b_incr2 <- new("Basket", contents = c("x", "y")) - dt <- getExportedValue("devpackage", "as.data.table")(b_incr2) + dt <- get("as.data.table", pos = "package:devpackage")(b_incr2) data.table::is.data.table(dt) && identical(dt$item, c("x", "y")) })) @@ -1556,7 +1556,7 @@ check("incr-reload: Basket direct call evaluated in pkg_env scope after reload", })) check("incr-reload: empty Basket yields 0-row DT after reload", quote({ - dt <- getExportedValue("devpackage", "as.data.table")(new("Basket", contents = character(0))) + dt <- get("as.data.table", pos = "package:devpackage")(new("Basket", contents = character(0))) data.table::is.data.table(dt) && nrow(dt) == 0L && identical(names(dt), "item") })) From 387678b4fd42660253c52c44650e13d193b601d3 Mon Sep 17 00:00:00 2001 From: "copilot-swe-agent[bot]" <198982749+Copilot@users.noreply.github.com> Date: Fri, 10 Apr 2026 07:24:37 +0000 Subject: [PATCH 4/4] test: add implicit generic checks in Stage 4b incremental reload Agent-Logs-Url: https://github.com/finccam/loadfast/sessions/1626ac4c-08cf-457f-bddc-8ad5aa513549 Co-authored-by: felix-andreas-finccam <266759557+felix-andreas-finccam@users.noreply.github.com> --- test_loadfast.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/test_loadfast.R b/test_loadfast.R index 39f876b..f852f4f 100644 --- a/test_loadfast.R +++ b/test_loadfast.R @@ -1536,6 +1536,14 @@ check("incr-reload: Basket method still registered after base.R changed", quote( existsMethod("as.data.table", "Basket") )) +check("incr-reload: as.data.table implicit generic still in ns_env after reload (not reverted to S3 fn)", quote( + is(get("as.data.table", envir = ns4b, inherits = FALSE), "genericFunction") +)) + +check("incr-reload: as.data.table in pkg_env is still the implicit generic after reload", quote( + is(get("as.data.table", pos = "package:devpackage", inherits = FALSE), "genericFunction") +)) + 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)