diff --git a/R/loadfast.R b/R/loadfast.R index 5f9255f..430ae87 100644 --- a/R/loadfast.R +++ b/R/loadfast.R @@ -1,9 +1,35 @@ message("Incremental reload is available via load_fast().") .loadfast.cache <- new.env(parent = emptyenv()) +.loadfast.cache.by_pkg <- new.env(parent = emptyenv()) .loadfast.state <- new.env(parent = emptyenv()) .loadfast.state$loading <- FALSE +.loadfast.source_many <- function(files, ns_env) { + old_tle <- getOption("topLevelEnvironment") + old_keep_source <- getOption("keep.source") + old_show_error_locations <- getOption("show.error.locations") + on.exit({ + options( + topLevelEnvironment = old_tle, + keep.source = old_keep_source, + show.error.locations = old_show_error_locations + ) + }, add = TRUE) + + options( + topLevelEnvironment = ns_env, + keep.source = TRUE, + show.error.locations = TRUE + ) + + for (f in files) { + .loadfast.source_one_eval(f, ns_env) + } + + invisible(NULL) +} + #' Load a package from source with MD5-based incremental reloading #' #' `load_fast()` is a lightweight alternative to `devtools::load_all()`. @@ -116,16 +142,55 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = cached <- .loadfast.cache[[abs_path]] } + ns_file <- file.path(abs_path, "NAMESPACE") + nsInfo <- NULL + if (file.exists(ns_file)) { + nsInfo <- parseNamespaceFile( + basename(abs_path), + dirname(abs_path), + mustExist = FALSE + ) + } + + current_dependency_fingerprint <- .loadfast.dependency_fingerprint(nsInfo) + active_ns_env <- if (pkg_name %in% loadedNamespaces()) { tryCatch(asNamespace(pkg_name), error = function(e) NULL) } else { NULL } + dependency_changed <- !is.null(cached) && + !identical( + if (is.null(cached$dependency_fingerprint)) NULL else cached$dependency_fingerprint, + current_dependency_fingerprint + ) + + + + dependency_changed_imports <- if (isTRUE(dependency_changed) && !is.null(current_dependency_fingerprint)) { + changed <- names(current_dependency_fingerprint)[vapply( + names(current_dependency_fingerprint), + function(name) { + old_value <- if (!is.null(cached$dependency_fingerprint) && name %in% names(cached$dependency_fingerprint)) { + cached$dependency_fingerprint[[name]] + } else { + NA_character_ + } + !identical(old_value, current_dependency_fingerprint[[name]]) + }, + logical(1) + )] + if (length(changed) == 0L) names(current_dependency_fingerprint) else changed + } else { + character(0) + } + can_incremental <- !is.null(cached) && !is.null(active_ns_env) && identical(cached$ns_env, active_ns_env) && - pkg_env_name %in% search() + pkg_env_name %in% search() && + !isTRUE(dependency_changed) if (can_incremental) { ns_env <- cached$ns_env @@ -156,6 +221,13 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = registered_added_reload_files <- setdiff(registered_reload_files_cmp, old_files_cmp) registered_added_reload_files <- new_files[new_files_cmp %in% intersect(new_files_cmp, registered_added_reload_files)] + dependency_refresh <- !is.null(nsInfo) && length(nsInfo$imports) > 0L + dependency_refresh_packages <- if (dependency_refresh) unique(vapply( + nsInfo$imports, + function(i) if (is.character(i)) i else i[[1L]], + character(1) + )) else character(0) + files_to_source <- unique(c(changed_files, added_files, registered_existing_reload_files, registered_added_reload_files)) files_to_source <- files_to_source[order(basename(files_to_source), files_to_source)] @@ -163,31 +235,34 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = if (!is.null(pending_reload_message)) { message(pending_reload_message) } + .loadfast.refresh_namespace_metadata(ns_env, nsInfo) + .loadfast.register_s3_methods(ns_env, nsInfo) + .loadfast.sync_pkg_env(ns_env, pkg_env) .loadfast.cache[[abs_path]] <- list( ns_env = ns_env, pkg_name = pkg_name, hashes = current_hashes, lock_hash = old_lock_hash, + dependency_fingerprint = current_dependency_fingerprint, registered_reload_files = character(0), pending_reload_message = NULL ) + .loadfast.cache.by_pkg[[pkg_name]] <- abs_path + message("No changes in ", r_dir_display, ".") .loadfast.source_helpers(abs_path, pkg_env, helpers, attach_testthat, pkg_name) .timer("TOTAL (no-change)") return(invisible(ns_env)) } - old_tle <- getOption("topLevelEnvironment") - on.exit(options(topLevelEnvironment = old_tle), add = TRUE) - options(topLevelEnvironment = ns_env) + .loadfast.refresh_namespace_metadata(ns_env, nsInfo) - for (f in files_to_source) { - .loadfast.source_one(f, ns_env) - } + .loadfast.source_many(files_to_source, ns_env) .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) + .loadfast.refresh_namespace_metadata(ns_env, nsInfo) + .loadfast.register_s3_methods(ns_env, nsInfo) + .loadfast.sync_pkg_env(ns_env, pkg_env) .timer("incr pkg_env sync") .loadfast.cache[[abs_path]] <- list( @@ -195,10 +270,14 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = pkg_name = pkg_name, hashes = current_hashes, lock_hash = old_lock_hash, + dependency_fingerprint = current_dependency_fingerprint, registered_reload_files = character(0), pending_reload_message = NULL ) + .loadfast.cache.by_pkg[[pkg_name]] <- abs_path + + n_changed <- length(changed_files) n_added <- length(added_files) n_registered_reloads <- length(unique(c(registered_existing_reload_files, registered_added_reload_files))) @@ -234,6 +313,45 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = # ---- FULL LOAD ---- + if (isTRUE(dependency_changed) && !isTRUE(full)) { + changed_imports <- names(current_dependency_fingerprint)[vapply( + names(current_dependency_fingerprint), + function(name) { + old_value <- if (!is.null(cached$dependency_fingerprint) && name %in% names(cached$dependency_fingerprint)) { + cached$dependency_fingerprint[[name]] + } else { + NA_character_ + } + !identical(old_value, current_dependency_fingerprint[[name]]) + }, + logical(1) + )] + if (length(changed_imports) == 0L) { + changed_imports <- names(current_dependency_fingerprint) + } + changed_imports <- changed_imports[nzchar(changed_imports)] + if (length(changed_imports) > 5L) { + changed_imports <- c( + changed_imports[seq_len(5L)], + paste0("and ", length(changed_imports) - 5L, " more package(s)") + ) + } + message( + "Dependency-triggered rebuild of ", + pkg_name, + " because imported package state changed [", + paste(changed_imports, collapse = ", "), + "]." + ) + message( + "Reloading ", + pkg_name, + " files [", + paste(basename(r_files), collapse = ", "), + "]." + ) + } + if (pkg_env_name %in% search()) { detach(pkg_env_name, character.only = TRUE, unload = FALSE, force = TRUE) } @@ -245,146 +363,22 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = } }) } + if (exists(pkg_name, envir = .loadfast.cache.by_pkg, inherits = FALSE)) { + rm(list = pkg_name, envir = .loadfast.cache.by_pkg) + } .timer("detach + unload old ns") - impenv <- new.env(parent = .BaseNamespaceEnv, hash = TRUE) - attr(impenv, "name") <- paste0("imports:", pkg_name) - - ns_env <- new.env(parent = impenv, hash = TRUE) - ns_env$.packageName <- pkg_name - - info <- new.env(hash = TRUE, parent = baseenv()) - ns_env[[".__NAMESPACE__."]] <- info - info[["spec"]] <- c(name = pkg_name, version = "0.0.0") - setNamespaceInfo(ns_env, "exports", new.env(hash = TRUE, parent = baseenv())) - setNamespaceInfo(ns_env, "imports", list(base = TRUE)) - setNamespaceInfo(ns_env, "path", abs_path) - setNamespaceInfo(ns_env, "dynlibs", NULL) - setNamespaceInfo(ns_env, "S3methods", matrix(NA_character_, 0L, 4L)) - ns_env[[".__S3MethodsTable__."]] <- new.env(hash = TRUE, parent = baseenv()) - - reg <- rlang::ns_registry_env() - reg[[pkg_name]] <- ns_env - - if (isNamespaceLoaded("methods")) { - methods::setPackageName(pkg_name, ns_env) - } + ns_env <- .loadfast.create_ns_env(pkg_name, abs_path) .timer("create + register ns env") - ns_file <- file.path(abs_path, "NAMESPACE") - if (file.exists(ns_file)) { - nsInfo <- parseNamespaceFile( - basename(abs_path), - dirname(abs_path), - mustExist = FALSE - ) + if (!is.null(nsInfo)) { .timer("parseNamespaceFile") - - for (i in nsInfo$imports) { - imp_label <- if (is.character(i)) i else i[[1L]] - tryCatch( - { - if (is.character(i)) { - namespaceImport(ns_env, loadNamespace(i), from = pkg_name) - } else if (!is.null(i$except)) { - namespaceImport( - ns_env, - loadNamespace(i[[1L]]), - from = pkg_name, - except = i$except - ) - } else { - namespaceImportFrom( - ns_env, - loadNamespace(i[[1L]]), - i[[2L]], - from = pkg_name - ) - } - }, - error = function(e) { - stop( - "Import failed for ", - deparse(i), - ": ", - conditionMessage(e), - call. = FALSE - ) - } - ) - .timer(paste0(" import: ", imp_label)) - } - - for (imp in nsInfo$importClasses) { - tryCatch( - namespaceImportClasses( - ns_env, - loadNamespace(imp[[1L]]), - imp[[2L]], - from = pkg_name - ), - error = function(e) { - stop( - "importClassesFrom failed for ", - imp[[1L]], - ": ", - conditionMessage(e), - call. = FALSE - ) - } - ) - .timer(paste0(" importClasses: ", imp[[1L]], " [", paste(imp[[2L]], collapse = ","), "]")) - } - for (imp in nsInfo$importMethods) { - tryCatch( - namespaceImportMethods( - ns_env, - loadNamespace(imp[[1L]]), - imp[[2L]], - from = pkg_name - ), - error = function(e) { - stop( - "importMethodsFrom failed for ", - imp[[1L]], - ": ", - conditionMessage(e), - call. = FALSE - ) - } - ) - .timer(paste0(" importMethods: ", imp[[1L]], " [", paste(imp[[2L]], collapse = ","), "]")) - } - imports_canonical <- list(base = TRUE) - for (i in nsInfo$imports) { - if (is.character(i)) { - imports_canonical[[i]] <- TRUE - } else { - pkg <- i[[1L]] - syms <- i[[2L]] - if (isTRUE(imports_canonical[[pkg]])) next - imports_canonical[[pkg]] <- c(imports_canonical[[pkg]], syms) - } - } - setNamespaceInfo(ns_env, "imports", imports_canonical) + .loadfast.process_imports(ns_env, nsInfo) } - old_tle <- getOption("topLevelEnvironment") - on.exit(options(topLevelEnvironment = old_tle), add = TRUE) - options(topLevelEnvironment = ns_env) - - for (f in r_files) { - .loadfast.source_one(f, ns_env) - } + .loadfast.full_load_code(r_files, ns_env, nsInfo) .timer(paste0("source ", length(r_files), " files")) - if (file.exists(ns_file)) { - exports <- nsInfo$exports - if (length(exports) > 0L) { - namespaceExport(ns_env, exports) - } - } - uses_testthat <- local({ test_dirs <- c( file.path(abs_path, "inst", "tests"), @@ -399,8 +393,7 @@ 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) + .loadfast.sync_pkg_env(ns_env, pkg_env) .timer("attach pkg to search path") if (isTRUE(helpers) && uses_testthat) { @@ -413,10 +406,14 @@ load_fast <- function(path = ".", helpers = TRUE, attach_testthat = NULL, full = pkg_name = pkg_name, hashes = current_hashes, lock_hash = current_lock_hash, + dependency_fingerprint = current_dependency_fingerprint, registered_reload_files = character(0), pending_reload_message = NULL ) + .loadfast.cache.by_pkg[[pkg_name]] <- abs_path + + message("Load ", length(r_files), " file(s) from ", r_dir_display, ".") .timer("TOTAL (full load)") invisible(ns_env) @@ -496,40 +493,233 @@ load_fast_register_reload <- function(path = ".", files, reason = NULL) { invisible(TRUE) } +.loadfast.create_ns_env <- function(pkg_name, abs_path) { + impenv <- new.env(parent = .BaseNamespaceEnv, hash = TRUE) + attr(impenv, "name") <- paste0("imports:", pkg_name) + + ns_env <- new.env(parent = impenv, hash = TRUE) + ns_env$.packageName <- pkg_name + + info <- new.env(hash = TRUE, parent = baseenv()) + ns_env[[".__NAMESPACE__."]] <- info + info[["spec"]] <- c(name = pkg_name, version = "0.0.0") + setNamespaceInfo(ns_env, "exports", new.env(hash = TRUE, parent = baseenv())) + setNamespaceInfo(ns_env, "imports", list(base = TRUE)) + setNamespaceInfo(ns_env, "path", abs_path) + setNamespaceInfo(ns_env, "dynlibs", NULL) + setNamespaceInfo(ns_env, "S3methods", matrix(NA_character_, 0L, 4L)) + ns_env[[".__S3MethodsTable__."]] <- new.env(hash = TRUE, parent = baseenv()) + + reg <- rlang::ns_registry_env() + reg[[pkg_name]] <- ns_env + + if (isNamespaceLoaded("methods")) { + methods::setPackageName(pkg_name, ns_env) + } + + ns_env +} + +.loadfast.process_imports <- function(ns_env, nsInfo) { + .loadfast.refresh_namespace_metadata(ns_env, nsInfo) +} + +.loadfast.full_load_code <- function(r_files, ns_env, nsInfo = NULL) { + .loadfast.source_many(r_files, ns_env) + + if (!is.null(nsInfo)) { + .loadfast.refresh_namespace_metadata(ns_env, nsInfo) + .loadfast.register_s3_methods(ns_env, nsInfo) + } + + invisible(NULL) +} + .loadfast.source_one <- function(f, ns_env) { + .loadfast.source_one_eval(f, ns_env) +} + +.loadfast.source_one_eval <- function(f, ns_env) { s4_pattern <- "no definition for class" - tryCatch( + lines <- readLines(f, warn = FALSE) + srcfile <- srcfilecopy( + f, + lines, + file.info(f)[1, "mtime"], + isFile = TRUE + ) + + exprs <- tryCatch( withCallingHandlers( - sys.source(f, envir = ns_env, keep.source = TRUE), - warning = function(w) { - if (grepl(s4_pattern, conditionMessage(w), fixed = TRUE)) { - invokeRestart("muffleWarning") - } - }, - message = function(m) { - if (grepl(s4_pattern, conditionMessage(m), fixed = TRUE)) { - invokeRestart("muffleMessage") - } + parse(text = lines, n = -1L, srcfile = srcfile), + error = function(e) { + stop("Failed to parse ", f, ": ", conditionMessage(e), call. = FALSE) } ), + error = function(e) { + stop("Failed to parse ", f, ": ", conditionMessage(e), call. = FALSE) + } + ) + + tryCatch( + { + for (expr in exprs) { + withCallingHandlers( + eval(expr, ns_env), + warning = function(w) { + if (grepl(s4_pattern, conditionMessage(w), fixed = TRUE)) { + invokeRestart("muffleWarning") + } + }, + message = function(m) { + if (grepl(s4_pattern, conditionMessage(m), fixed = TRUE)) { + invokeRestart("muffleMessage") + } + } + ) + } + }, error = function(e) { stop("Failed to source ", f, ": ", conditionMessage(e), call. = FALSE) } ) } -.loadfast.loaded_package_path <- function(pkg_name) { - if (!(pkg_name %in% loadedNamespaces())) { - return(NULL) +.loadfast.refresh_namespace_metadata <- function(ns_env, nsInfo) { + if (is.null(nsInfo)) { + return(invisible(NULL)) + } + + impenv <- parent.env(ns_env) + existing_imports <- ls(envir = impenv, all.names = TRUE) + if (length(existing_imports) > 0L) { + rm(list = existing_imports, envir = impenv) + } + + for (i in nsInfo$imports) { + tryCatch( + { + if (is.character(i)) { + namespaceImport(ns_env, loadNamespace(i), from = ns_env$.packageName) + } else if (!is.null(i$except)) { + namespaceImport( + ns_env, + loadNamespace(i[[1L]]), + from = ns_env$.packageName, + except = i$except + ) + } else { + namespaceImportFrom( + ns_env, + loadNamespace(i[[1L]]), + i[[2L]], + from = ns_env$.packageName + ) + } + }, + error = function(e) { + stop( + "Import failed for ", + deparse(i), + ": ", + conditionMessage(e), + call. = FALSE + ) + } + ) + } + + for (imp in nsInfo$importClasses) { + tryCatch( + namespaceImportClasses( + ns_env, + loadNamespace(imp[[1L]]), + imp[[2L]], + from = ns_env$.packageName + ), + error = function(e) { + stop( + "importClassesFrom failed for ", + imp[[1L]], + ": ", + conditionMessage(e), + call. = FALSE + ) + } + ) + } + + for (imp in nsInfo$importMethods) { + tryCatch( + namespaceImportMethods( + ns_env, + loadNamespace(imp[[1L]]), + imp[[2L]], + from = ns_env$.packageName + ), + error = function(e) { + stop( + "importMethodsFrom failed for ", + imp[[1L]], + ": ", + conditionMessage(e), + call. = FALSE + ) + } + ) + } + + imports_canonical <- list(base = TRUE) + for (i in nsInfo$imports) { + if (is.character(i)) { + imports_canonical[[i]] <- TRUE + } else { + pkg <- i[[1L]] + syms <- i[[2L]] + if (isTRUE(imports_canonical[[pkg]])) next + imports_canonical[[pkg]] <- c(imports_canonical[[pkg]], syms) + } + } + setNamespaceInfo(ns_env, "imports", imports_canonical) + + exports_env <- getNamespaceInfo(ns_env, "exports") + existing_exports <- ls(envir = exports_env, all.names = TRUE) + if (length(existing_exports) > 0L) { + rm(list = existing_exports, envir = exports_env) + } + exports <- nsInfo$exports + if (length(exports) > 0L) { + namespaceExport(ns_env, exports) + } + + invisible(NULL) +} + +.loadfast.register_s3_methods <- function(ns_env, nsInfo) { + if (is.null(nsInfo) || is.null(nsInfo$S3methods) || length(nsInfo$S3methods) == 0L) { + return(invisible(NULL)) } tryCatch( - { - loaded_path <- getNamespaceInfo(asNamespace(pkg_name), "path") - if (is.null(loaded_path) || !nzchar(loaded_path)) NULL else normalizePath(loaded_path, mustWork = FALSE) - }, - error = function(e) NULL + registerS3methods(nsInfo$S3methods, ns_env$.packageName, ns_env), + error = function(e) { + stop("registerS3methods failed: ", conditionMessage(e), call. = FALSE) + } ) + + invisible(NULL) +} + +.loadfast.sync_pkg_env <- function(ns_env, pkg_env) { + pkg_objects <- ls(envir = pkg_env, all.names = TRUE) + if (length(pkg_objects) > 0L) { + rm(list = pkg_objects, envir = pkg_env) + } + + list2env(as.list(ns_env, all.names = FALSE), envir = pkg_env) + list2env(as.list(parent.env(ns_env), all.names = TRUE), envir = pkg_env) + + invisible(NULL) } .loadfast.source_helpers <- function(abs_path, pkg_env, helpers, attach_testthat, pkg_name) { @@ -588,3 +778,101 @@ load_fast_register_reload <- function(path = ".", files, reason = NULL) { current <- parent } } + +.loadfast.loaded_package_path <- function(pkg_name) { + if (!(pkg_name %in% loadedNamespaces())) { + return(NULL) + } + + tryCatch( + { + loaded_path <- getNamespaceInfo(asNamespace(pkg_name), "path") + if (is.null(loaded_path) || !nzchar(loaded_path)) NULL else normalizePath(loaded_path, mustWork = FALSE) + }, + error = function(e) NULL + ) +} + + + +.loadfast.dependency_fingerprint <- function(nsInfo) { + if (is.null(nsInfo) || length(nsInfo$imports) == 0L) { + return(NULL) + } + + imported_packages <- unique(vapply( + nsInfo$imports, + function(i) if (is.character(i)) i else i[[1L]], + character(1) + )) + imported_packages <- imported_packages[nzchar(imported_packages)] + + if (length(imported_packages) == 0L) { + return(NULL) + } + + custom_imports <- imported_packages[grepl("pkg$", imported_packages)] + + cached_imports <- imported_packages[vapply( + imported_packages, + function(import_pkg) .loadfast.cache_has_package(import_pkg), + logical(1) + )] + + if (length(cached_imports) == 0L) { + return(NULL) + } + + fingerprint <- stats::setNames( + vapply( + cached_imports, + function(import_pkg) { + if (!(import_pkg %in% loadedNamespaces())) { + return("UNLOADED") + } + + ns_env <- tryCatch(asNamespace(import_pkg), error = function(e) NULL) + if (is.null(ns_env)) { + return("UNAVAILABLE") + } + + ns_path <- tryCatch(getNamespaceInfo(ns_env, "path"), error = function(e) NULL) + ns_path <- if (is.null(ns_path) || !nzchar(ns_path)) "" else normalizePath(ns_path, mustWork = FALSE) + + path_cache <- .loadfast.cache_entry_for_package(import_pkg) + path_hash <- if (is.null(path_cache) || is.null(path_cache$hashes)) { + "" + } else { + paste(names(path_cache$hashes), unname(path_cache$hashes), collapse = "|") + } + + paste0(ns_path, "::", path_hash) + }, + character(1) + ), + cached_imports + ) + + fingerprint +} + +.loadfast.cache_entry_for_package <- function(pkg_name) { + if (!exists(pkg_name, envir = .loadfast.cache.by_pkg, inherits = FALSE)) { + return(NULL) + } + + cache_key <- .loadfast.cache.by_pkg[[pkg_name]] + if (!is.character(cache_key) || length(cache_key) != 1L || !nzchar(cache_key)) { + return(NULL) + } + + if (!exists(cache_key, envir = .loadfast.cache, inherits = FALSE)) { + return(NULL) + } + + .loadfast.cache[[cache_key]] +} + +.loadfast.cache_has_package <- function(pkg_name) { + !is.null(.loadfast.cache_entry_for_package(pkg_name)) +} diff --git a/TODO.md b/TODO.md new file mode 100644 index 0000000..10607b9 --- /dev/null +++ b/TODO.md @@ -0,0 +1,107 @@ +# TODO + +## Status legend +- `done` resolved and implemented +- `open` still needs a decision or implementation +- `deferred` intentionally postponed + +## Checklist + +- `done` Import failures are fatal instead of warning-and-continuing. +- `done` Dependency changes should trigger a full rebuild of the dependent package rather than trying to patch an existing namespace in place. +- `open` Make dependency-triggered rebuild messaging explicit: say why the rebuild happened, which dependency triggered it, and what package code is being reloaded. +- `done` Trigger dependency-triggered rebuilds only when imported package state changed, not on every reload of a package with imports. +- `done` Dependency fingerprint tracking now only considers imported packages that were themselves loaded via `load_fast()`. +- `done` Dependency-triggered rebuild messages are implemented and show why the rebuild happened, which imported package changed, and which files are being reloaded. +- `open` Tighten incremental cache validation so cached namespace state is reused only when it is still the active registered namespace. +- `open` Decide whether switching the same package name to a different path should force a full reload. +- `open` Decide whether switching the same package name to a different path should invalidate other cache entries for that package name. +- `open` Fix package root discovery for paths inside a package such as `R/`, individual files, and `tests/testthat/`. +- `open` Decide whether S3 support is required for the current milestone. +- `open` If S3 is required, implement proper S3 registration and reload behavior. +- `open` If S3 is not implemented soon, document it as unsupported or partial. +- `open` Decide how to handle a `Package:` name change in place for the same directory path. +- `open` Decide whether dependent packages should refresh imports after a same-name dependency path switch. +- `open` Confirm that inter-package behavior should target `pkgload::load_all()` semantics where practical. +- `open` Decide whether current failing tests should assert target behavior or only current behavior when the two differ. +- `open` Keep the long-lived session test model or introduce stronger cleanup/isolation between stages. +- `open` Keep warning assertions narrow and scenario-specific instead of asserting “no warnings at all”. +- `open` Clean up invalid test assumptions that relied on synthetic package marker functions. +- `deferred` Define desired `.onLoad()` behavior. +- `deferred` Define desired `.onAttach()` behavior. +- `deferred` Decide whether hook behavior should match `pkgload` closely or be documented as intentionally different. +- `deferred` Decide whether to refactor loader internals before additional feature work beyond small targeted helper extraction. + +## Dependency-triggered full rebuild implementation plan + +1. Keep the current fast incremental path unchanged for ordinary same-package file edits. + - No-change reloads and local-file-only reloads should keep current behavior. + - Existing messaging and stale-symbol tradeoffs should remain intact in this path. + +2. Use dependency fingerprints only as a trigger for the rebuild decision. + - Track only imported packages that were themselves loaded via `load_fast()`. + - If none of those imported packages changed, do not trigger a rebuild. + - If one or more changed, rebuild the dependent package fully. + +3. Route dependency-triggered rebuilds through a more `pkgload`-like full-load path. + - The trigger and user-facing message now work. + - The current full-load path is still not semantically close enough yet for `import(pkg)` and `importFrom(pkg, sym)` rebuild correctness. + - Improve the full-load path instead of trying to patch imports incrementally. + +4. Current precise namespace findings from the rebuild experiments. + - `import(pkg)` case: + - dependency-triggered rebuild fires + - rebuilt function environment is correct + - rebuilt imports environment is correct + - imported symbol still resolves to the old function + - `importFrom(pkg, sym)` case: + - dependency-triggered rebuild fires + - rebuilt function environment is correct + - rebuilt imports environment is correct + - imported symbol is refreshed correctly + - rebuilt function still behaves as if it were using the old binding + - Conclusion: + - the remaining bug is deeper than trigger logic or messaging + - the rebuilt namespace still differs from real package-loading semantics + - the next focused implementation target is import processing, not rebuild triggering + +5. Compare the full-load path directly against `pkgload` in this order. + - Namespace creation: + - current full-load namespace creation has been extracted into `.loadfast.create_ns_env()` + - keep behavior stable while reworking helpers one at a time + - Import processing: + - this is the next focused task + - rework `.loadfast.process_imports()` toward `pkgload` / base `loadNamespace` semantics + - pay special attention to whole-package imports vs `importFrom()` + - Code sourcing: + - current full-load code loading has been extracted into `.loadfast.full_load_code()` + - current parse/eval sourcing should be revisited only after import processing is reworked + - Export registration: + - verify export metadata setup is happening at the right point in the rebuild flow + +6. Keep dependency-triggered rebuild messaging explicit and stable. + - Message should say: + - this is a dependency-triggered rebuild + - which imported package(s) changed + - which package files are being reloaded + - Keep ordinary no-change messaging unchanged when dependency rebuild is not triggered. + +7. Add or keep focused tests for the dependency-triggered rebuild path. + - `import(pkg)` case: rebuilding dependent package picks up changed dependency behavior. + - `importFrom(pkg, sym)` case: rebuilding dependent package picks up changed dependency behavior. + - Combined local-change + dependency-change case. + - Messaging checks: reason and triggering dependency are reported. + - Negative case: no dependency change does not trigger rebuild messaging. + +8. After dependency-triggered rebuild is working, simplify the namespace-refresh experiments. + - Remove dead incremental import-refresh logic that no longer contributes to behavior. + - Keep one clear fast path and one clear dependency-triggered rebuild path. + +## Recommended next actions + +1. Keep dependency fingerprint tracking only as the trigger for rebuild decisions. +2. Rework `.loadfast.process_imports()` toward `pkgload` / base `loadNamespace` semantics. +3. Use the current failing dependency tests as the acceptance checks for that import-processing rework. +4. Keep explicit user-facing messages for dependency-triggered rebuilds. +5. Revisit full-load code sourcing only after import processing is corrected. +6. Decide and document the short-term S3 stance: implement now or mark unsupported. diff --git a/test_loadfast.R b/test_loadfast.R index 1b02b21..96afb28 100644 --- a/test_loadfast.R +++ b/test_loadfast.R @@ -15,6 +15,7 @@ check <- function(description, expr) { if (.test_filter_active && !grepl(.test_filter, description, perl = TRUE)) { return(invisible(NULL)) } + result <- tryCatch( { ok <- eval(expr, envir = parent.frame()) @@ -148,6 +149,22 @@ remove_renv_lock <- function(pkg_path) { } } +add_s3_files <- function(pkg_path, generic_body = "paste0(\"base:\", x)") { + writeLines(c( + "tag <- function(x, ...) {", + " UseMethod(\"tag\")", + "}", + "", + "tag.default <- function(x, ...) {", + " paste0(\"default:\", x)", + "}", + "", + "tag.character <- function(x, ...) {", + paste0(" ", generic_body), + "}" + ), file.path(pkg_path, "R", "s3_methods.R")) +} + # ============================================================================ # STAGE 1: Load frozen devpackage baseline # ============================================================================ @@ -1113,109 +1130,179 @@ check("multi-pkg: helpers disabled keeps test helper out of packageb env", quote )) # -------------------------------------------------------------------------- -# 3f: Same package name from different path warns and replaces prior load +# 3f: Inter-package dependency reload # -------------------------------------------------------------------------- -cat("\n--- 3f: same package name from different path warns ---\n\n") +cat("\n--- 3f: inter-package dependency reload ---\n\n") -tmp_same_a <- tempfile("loadfast_same_a_") -tmp_same_b <- tempfile("loadfast_same_b_") -copy_baseline(tmp_same_a) -copy_baseline(tmp_same_b) +tmp_dep_a <- tempfile("loadfast_dep_a_") +tmp_dep_b <- tempfile("loadfast_dep_b_") +copy_baseline(tmp_dep_a) +copy_baseline(tmp_dep_b) -same_name_reload <- capture_warnings( - load_fast(tmp_same_a, helpers = FALSE, attach_testthat = FALSE) +rename_package(tmp_dep_a, "depapkg") +rename_package(tmp_dep_b, "depbpkg") + +replace_namespace_imports( + file.path(tmp_dep_b, "NAMESPACE"), + c( + "import(depapkg)", + "importFrom(rlang, ns_registry_env)", + "import(methods)", + "importFrom(R6, R6Class)", + "importFrom(data.table,\":=\")", + "importFrom(data.table,as.data.table)", + "importFrom(data.table,data.table)" + ) ) -check("same-name: first load of this path returns a namespace", quote( - is.environment(same_name_reload$value) && isNamespace(same_name_reload$value) -)) +writeLines(c( + "compute_with_a <- function(a, b) {", + " add(a, b) * 10", + "}", + "", + 'depbpkg <- function() "depbpkg"' +), file.path(tmp_dep_b, "R", "000_init.R")) -same_name_reload2 <- capture_warnings( - load_fast(tmp_same_b, helpers = FALSE, attach_testthat = FALSE) -) +ns_dep_a <- load_fast(tmp_dep_a, helpers = FALSE, attach_testthat = FALSE) +ns_dep_b <- load_fast(tmp_dep_b, helpers = FALSE, attach_testthat = FALSE) -check("same-name: warns when same package name is loaded from different path", quote( - any(grepl("already loaded from a different path", same_name_reload2$warnings, fixed = TRUE)) +check("inter-pkg: packageb can call imported packagea::add()", quote( + get("compute_with_a", envir = ns_dep_b)(1, 2) == 30 )) -check("same-name: warning mentions replacement", quote( - any(grepl("will replace the existing loaded package", same_name_reload2$warnings, fixed = TRUE)) +check("inter-pkg: packageb attached env can call imported packagea::add()", quote( + get("compute_with_a", pos = "package:depbpkg")(2, 3) == 50 )) -check("same-name: devpackage remains loaded after replacement", quote( - "devpackage" %in% loadedNamespaces() && "package:devpackage" %in% search() +writeLines(c( + "add <- function(a, b) {", + " a + b + 1000", + "}", + "", + "scale_vector <- function(x, factor = 1) {", + " x * factor", + "}", + "", + "summarize_values <- function(x) {", + " list(mean = mean(x), sd = sd(x), n = length(x))", + "}", + "", + "mutate_dt <- function(x, times = 2L) {", + " dt <- as.data.table(list(val = x))", + " dt[, scaled := val * times]", + " dt", + "}" +), file.path(tmp_dep_a, "R", "base.R")) + +ns_dep_a2 <- load_fast(tmp_dep_a, helpers = FALSE, attach_testthat = FALSE) + +check("inter-pkg: packagea reload updates add()", quote( + get("add", envir = ns_dep_a2)(1, 2) == 1003 )) -check("same-name: second path is now the active namespace path", quote( - identical( - normalizePath(getNamespaceInfo(asNamespace("devpackage"), "path"), mustWork = FALSE), - normalizePath(tmp_same_b, mustWork = FALSE) - ) +check("inter-pkg: packageb does not update until it is reloaded", quote( + get("compute_with_a", envir = ns_dep_b)(1, 2) == 30 )) +check("inter-pkg: packageb sees reloaded packagea behavior after its own reload", quote({ + ns_dep_b2 <- load_fast(tmp_dep_b, helpers = FALSE, attach_testthat = FALSE) + + get("compute_with_a", envir = ns_dep_b2)(1, 2) == 10030 +})) + +check("inter-pkg: packageb attached env sees reloaded packagea behavior", quote({ + ns_dep_b3 <- load_fast(tmp_dep_b, helpers = FALSE, attach_testthat = FALSE) + + get("compute_with_a", pos = "package:depbpkg")(2, 3) == 10050 +})) + # -------------------------------------------------------------------------- -# 3g: Same-name different-path cache flip-flop and renv.lock path scoping +# 3g: Inter-package importFrom(packagea, add) reload # -------------------------------------------------------------------------- -cat("\n--- 3g: same-name path flip-flop and renv.lock path scoping ---\n\n") +cat("\n--- 3g: inter-package importFrom(packagea, add) reload ---\n\n") -tmp_flip_a <- tempfile("loadfast_flip_a_") -tmp_flip_b <- tempfile("loadfast_flip_b_") -copy_baseline(tmp_flip_a) -copy_baseline(tmp_flip_b) +tmp_dep_from_a <- tempfile("loadfast_dep_from_a_") +tmp_dep_from_b <- tempfile("loadfast_dep_from_b_") +copy_baseline(tmp_dep_from_a) +copy_baseline(tmp_dep_from_b) -flip_a1 <- capture_warnings( - load_fast(tmp_flip_a, helpers = FALSE, attach_testthat = FALSE) -) +rename_package(tmp_dep_from_a, "fromapkg") +rename_package(tmp_dep_from_b, "frombpkg") -check("flip-flop: initial load of path A returns a namespace", quote( - is.environment(flip_a1$value) && isNamespace(flip_a1$value) -)) +writeLines(c( + "export(add)", + "importFrom(rlang, ns_registry_env)", + "import(methods)", + "importFrom(R6, R6Class)", + "importFrom(data.table,\":=\")", + "importFrom(data.table,as.data.table)", + "importFrom(data.table,data.table)" +), file.path(tmp_dep_from_a, "NAMESPACE")) -flip_b1 <- capture_warnings( - load_fast(tmp_flip_b, helpers = FALSE, attach_testthat = FALSE) +replace_namespace_imports( + file.path(tmp_dep_from_b, "NAMESPACE"), + c( + "importFrom(fromapkg,add)", + "importFrom(rlang, ns_registry_env)", + "import(methods)", + "importFrom(R6, R6Class)", + "importFrom(data.table,\":=\")", + "importFrom(data.table,as.data.table)", + "importFrom(data.table,data.table)" + ) ) -check("flip-flop: switching from path A to path B warns", quote( - any(grepl("already loaded from a different path", flip_b1$warnings, fixed = TRUE)) -)) - -flip_a2 <- capture_warnings( - load_fast(tmp_flip_a, helpers = FALSE, attach_testthat = FALSE) -) +writeLines(c( + "compute_with_add <- function(a, b) {", + " add(a, b) * 100", + "}", + "", + 'frombpkg <- function() "frombpkg"' +), file.path(tmp_dep_from_b, "R", "000_init.R")) -check("flip-flop: switching back from path B to path A warns", quote( - any(grepl("already loaded from a different path", flip_a2$warnings, fixed = TRUE)) -)) +ns_dep_from_a <- load_fast(tmp_dep_from_a, helpers = FALSE, attach_testthat = FALSE) +ns_dep_from_b <- load_fast(tmp_dep_from_b, helpers = FALSE, attach_testthat = FALSE) -check("flip-flop: path A is active again after switching back", quote( - identical( - normalizePath(getNamespaceInfo(asNamespace("devpackage"), "path"), mustWork = FALSE), - normalizePath(tmp_flip_a, mustWork = FALSE) - ) +check("inter-pkg-from: packageb can call importFrom(packagea, add)", quote( + get("compute_with_add", envir = ns_dep_from_b)(1, 2) == 300 )) writeLines(c( - "{", - ' "flip": true', + "add <- function(a, b) {", + " a + b + 10", + "}", + "", + "scale_vector <- function(x, factor = 1) {", + " x * factor", + "}", + "", + "summarize_values <- function(x) {", + " list(mean = mean(x), sd = sd(x), n = length(x))", + "}", + "", + "mutate_dt <- function(x, times = 2L) {", + " dt <- as.data.table(list(val = x))", + " dt[, scaled := val * times]", + " dt", "}" -), file.path(tmp_flip_a, "renv.lock")) +), file.path(tmp_dep_from_a, "R", "base.R")) -flip_a_lock <- capture_warnings( - load_fast(tmp_flip_a, helpers = FALSE, attach_testthat = FALSE) -) +ns_dep_from_a2 <- load_fast(tmp_dep_from_a, helpers = FALSE, attach_testthat = FALSE) -check("flip-flop: renv.lock warning is path-scoped to path A", quote( - any(grepl("renv.lock changed since the initial load_fast() call for this path", flip_a_lock$warnings, fixed = TRUE)) +check("inter-pkg-from: packagea reload updates add()", quote( + get("add", envir = ns_dep_from_a2)(1, 2) == 13 )) -flip_b_lock <- capture_warnings( - load_fast(tmp_flip_b, helpers = FALSE, attach_testthat = FALSE) -) - -check("flip-flop: path B does not inherit path A renv.lock warning", quote( - !any(grepl("renv.lock changed since the initial load_fast() call for this path", flip_b_lock$warnings, fixed = TRUE)) +check("inter-pkg-from: packageb still uses old imported binding before reload", quote( + get("compute_with_add", envir = ns_dep_from_b)(1, 2) == 300 )) +check("inter-pkg-from: packageb sees new imported binding after reload", quote({ + ns_dep_from_b2 <- load_fast(tmp_dep_from_b, helpers = FALSE, attach_testthat = FALSE) + + get("compute_with_add", envir = ns_dep_from_b2)(1, 2) == 1300 +})) + # -------------------------------------------------------------------------- # 3h: Dependent package load order and missing dependency failures # -------------------------------------------------------------------------- @@ -1282,9 +1369,113 @@ check("dep-order: loading packageb after packagea succeeds", quote( )) # -------------------------------------------------------------------------- -# 3i: Packages without helpers and empty R/ early return +# 3i: Same package name from different path warns and replaces prior load +# -------------------------------------------------------------------------- +cat("\n--- 3i: same package name from different path warns ---\n\n") + +tmp_same_a <- tempfile("loadfast_same_a_") +tmp_same_b <- tempfile("loadfast_same_b_") +copy_baseline(tmp_same_a) +copy_baseline(tmp_same_b) + +same_name_reload <- capture_warnings( + load_fast(tmp_same_a, helpers = FALSE, attach_testthat = FALSE) +) + +check("same-name: first load of this path returns a namespace", quote( + is.environment(same_name_reload$value) && isNamespace(same_name_reload$value) +)) + +same_name_reload2 <- capture_warnings( + load_fast(tmp_same_b, helpers = FALSE, attach_testthat = FALSE) +) + +check("same-name: warns when same package name is loaded from different path", quote( + any(grepl("already loaded from a different path", same_name_reload2$warnings, fixed = TRUE)) +)) + +check("same-name: warning mentions replacement", quote( + any(grepl("will replace the existing loaded package", same_name_reload2$warnings, fixed = TRUE)) +)) + +check("same-name: devpackage remains loaded after replacement", quote( + "devpackage" %in% loadedNamespaces() && "package:devpackage" %in% search() +)) + +check("same-name: second path is now the active namespace path", quote( + identical( + normalizePath(getNamespaceInfo(asNamespace("devpackage"), "path"), mustWork = FALSE), + normalizePath(tmp_same_b, mustWork = FALSE) + ) +)) + +# -------------------------------------------------------------------------- +# 3j: Same-name different-path cache flip-flop and renv.lock path scoping # -------------------------------------------------------------------------- -cat("\n--- 3i: no-helper package and empty R package ---\n\n") +cat("\n--- 3j: same-name path flip-flop and renv.lock path scoping ---\n\n") + +tmp_flip_a <- tempfile("loadfast_flip_a_") +tmp_flip_b <- tempfile("loadfast_flip_b_") +copy_baseline(tmp_flip_a) +copy_baseline(tmp_flip_b) + +flip_a1 <- capture_warnings( + load_fast(tmp_flip_a, helpers = FALSE, attach_testthat = FALSE) +) + +check("flip-flop: initial load of path A returns a namespace", quote( + is.environment(flip_a1$value) && isNamespace(flip_a1$value) +)) + +flip_b1 <- capture_warnings( + load_fast(tmp_flip_b, helpers = FALSE, attach_testthat = FALSE) +) + +check("flip-flop: switching from path A to path B warns", quote( + any(grepl("already loaded from a different path", flip_b1$warnings, fixed = TRUE)) +)) + +flip_a2 <- capture_warnings( + load_fast(tmp_flip_a, helpers = FALSE, attach_testthat = FALSE) +) + +check("flip-flop: switching back from path B to path A warns", quote( + any(grepl("already loaded from a different path", flip_a2$warnings, fixed = TRUE)) +)) + +check("flip-flop: path A is active again after switching back", quote( + identical( + normalizePath(getNamespaceInfo(asNamespace("devpackage"), "path"), mustWork = FALSE), + normalizePath(tmp_flip_a, mustWork = FALSE) + ) +)) + +writeLines(c( + "{", + ' "flip": true', + "}" +), file.path(tmp_flip_a, "renv.lock")) + +flip_a_lock <- capture_warnings( + load_fast(tmp_flip_a, helpers = FALSE, attach_testthat = FALSE) +) + +check("flip-flop: renv.lock warning is path-scoped to path A", quote( + any(grepl("renv.lock changed since the initial load_fast() call for this path", flip_a_lock$warnings, fixed = TRUE)) +)) + +flip_b_lock <- capture_warnings( + load_fast(tmp_flip_b, helpers = FALSE, attach_testthat = FALSE) +) + +check("flip-flop: path B does not inherit path A renv.lock warning", quote( + !any(grepl("renv.lock changed since the initial load_fast() call for this path", flip_b_lock$warnings, fixed = TRUE)) +)) + +# -------------------------------------------------------------------------- +# 3k: Packages without helpers and empty R/ early return +# -------------------------------------------------------------------------- +cat("\n--- 3k: no-helper package and empty R package ---\n\n") tmp_no_helpers <- tempfile("loadfast_no_helpers_") copy_baseline(tmp_no_helpers) @@ -1332,9 +1523,9 @@ check("empty-r: emits no R files found message", quote( )) # -------------------------------------------------------------------------- -# 3j: Root discovery and cache identity for relative/absolute/inside-package +# 3l: Root discovery and cache identity for relative/absolute/inside-package # -------------------------------------------------------------------------- -cat("\n--- 3j: root discovery and path identity ---\n\n") +cat("\n--- 3l: root discovery and path identity ---\n\n") root_rel <- load_fast("devpackage", helpers = FALSE, attach_testthat = FALSE) root_abs <- load_fast(normalizePath("devpackage", mustWork = TRUE), helpers = FALSE, attach_testthat = FALSE) @@ -1366,6 +1557,45 @@ check("path-root: absolute path to same package does not warn about different pa !any(grepl("already loaded from a different path", abs_reload_no_warning$warnings, fixed = TRUE)) )) +# -------------------------------------------------------------------------- +# 3m: S3 method reload +# -------------------------------------------------------------------------- +cat("\n--- 3m: S3 method reload ---\n\n") + +tmp_s3 <- tempfile("loadfast_s3_methods_") +copy_baseline(tmp_s3) +add_s3_files(tmp_s3, 'paste0("base:", x)') + +ns_s3 <- load_fast(tmp_s3, helpers = FALSE, attach_testthat = FALSE) + +check("s3: tag generic dispatches to character method", quote( + get("tag", envir = ns_s3)("abc") == "base:abc" +)) + +writeLines(c( + "tag <- function(x, ...) {", + " UseMethod(\"tag\")", + "}", + "", + "tag.default <- function(x, ...) {", + " paste0(\"default:\", x)", + "}", + "", + "tag.character <- function(x, ...) {", + ' paste0("changed:", x)', + "}" +), file.path(tmp_s3, "R", "s3_methods.R")) + +ns_s3_2 <- load_fast(tmp_s3, helpers = FALSE, attach_testthat = FALSE) + +check("s3: incremental reload updates character method dispatch", quote( + get("tag", envir = ns_s3_2)("abc") == "changed:abc" +)) + +check("s3: attached env also uses updated character method", quote( + get("tag", pos = "package:devpackage")("xyz") == "changed:xyz" +)) + # ============================================================================ # STAGE 4: Incremental-specific tests # These test behaviors are unique to the incremental loader: no-change