From f2f077b6c8c8180ae71c53d6fb6744368c5225b7 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Wed, 23 Dec 2015 10:13:35 -0500 Subject: [PATCH 1/4] Unregister S3 methods explicitly This is a workaround for a bug in base R. unloadNamespace does not unregister any S3 methods, so the promises are invalid if you install a new version of a package, try to unload and re-load the package. See https://stat.ethz.ch/pipermail/r-devel/2015-December/072150.html for more details and a reproducible example. This fixes the common lazy-load errors people often run into when trying to use devtools' install functions. Fixes #419, #503, #942, #631 --- R/unload.r | 43 +++++++++++++++++++++++++++++++++++-------- 1 file changed, 35 insertions(+), 8 deletions(-) diff --git a/R/unload.r b/R/unload.r index ab1fd4e5e..8472d440d 100644 --- a/R/unload.r +++ b/R/unload.r @@ -30,14 +30,9 @@ unload <- function(pkg = ".") { pkg <- as.package(pkg) - # This is a hack to work around unloading devtools itself. The unloading - # process normally makes other devtools functions inaccessible, - # resulting in "Error in unload(pkg) : internal error -3 in R_decompress1". - # If we simply access them here using as.list (without calling them), then - # they will remain available for use later. - if (pkg$package == "devtools") { - as.list(ns_env(pkg)) - } + ns <- asNamespace(pkg$package) + + unregister_S3_methods(ns) # If the package was loaded with devtools, any s4 classes that were created # by the package need to be removed in a special way. @@ -78,6 +73,38 @@ unload <- function(pkg = ".") { unload_dll(pkg) } +unregister_S3_methods <- function(ns) { + S3_methods <- getNamespaceInfo(ns, "S3methods") + + unregister <- function(name, class, method) { + # This code was adapted from the .registerS3method internal function of + # base::registerS3methods + # https://github.com/wch/r-source/blob/05b76baa411afd3e9d0f3fc3c09a9a252a0a9100/src/library/base/R/namespace.R#L1398-L1426 + env <- + if (!is.na(x <- .knownS3Generics[name])) { + asNamespace(x) + } else { + if(is.null(genfun <- get0(name, envir = ns))) { + stop(sprintf("object '%s' not found while unloading namespace '%s'", + name, getNamespaceName(ns)), call. = FALSE) + } + if(.isMethodsDispatchOn() && methods::is(genfun, "genericFunction")) { + genfun <- genfun@default # nearly always, the S3 generic + } + if (typeof(genfun) == "closure") { + environment(genfun) + } else { + baseenv() + } + } + table <- get(".__S3MethodsTable__.", envir = env, inherits = FALSE) + rm(list = method, envir = table) + } + for (i in seq_len(NROW(S3_methods))) { + unregister(S3_methods[i, 1], S3_methods[i, 2], S3_methods[i, 3]) + } +} + # This unloads dlls loaded by either library() or load_all() unload_dll <- function(pkg = ".") { pkg <- as.package(pkg) From 200b631d42192c966dfacff5a48b51edd837f70f Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Wed, 23 Dec 2015 17:22:23 -0500 Subject: [PATCH 2/4] Simply force all the promises rather than removing them. --- R/install.r | 4 ++++ R/load.r | 7 +++---- R/unload.r | 43 ++++++++----------------------------------- 3 files changed, 15 insertions(+), 39 deletions(-) diff --git a/R/install.r b/R/install.r index 8e8fccbb6..936ac6373 100644 --- a/R/install.r +++ b/R/install.r @@ -63,6 +63,10 @@ install <- function(pkg = ".", reload = TRUE, quick = FALSE, local = TRUE, pkg <- as.package(pkg) check_build_tools(pkg) + if (is_loaded(pkg)) { + eapply(ns_env(pkg), force, all.names = TRUE) + } + if (!quiet) { message("Installing ", pkg$package) } diff --git a/R/load.r b/R/load.r index 7db25db0a..cba32b98e 100644 --- a/R/load.r +++ b/R/load.r @@ -96,11 +96,10 @@ load_all <- function(pkg = ".", reset = TRUE, recompile = FALSE, # Reloading devtools is a special case. Normally, objects in the # namespace become inaccessible if the namespace is unloaded before the - # the object has been accessed. This is kind of a hack - using as.list - # on the namespace accesses each object, making the objects accessible - # later, after the namespace is unloaded. + # object has been accessed. Instead we force the object so they will still be + # accessible. if (pkg$package == "devtools") { - as.list(ns_env(pkg)) + eapply(ns_env(pkg), force, all.names = TRUE) } # Check description file is ok diff --git a/R/unload.r b/R/unload.r index 8472d440d..4067c5fde 100644 --- a/R/unload.r +++ b/R/unload.r @@ -30,9 +30,14 @@ unload <- function(pkg = ".") { pkg <- as.package(pkg) - ns <- asNamespace(pkg$package) - - unregister_S3_methods(ns) + # This is a hack to work around unloading devtools itself. The unloading + # process normally makes other devtools functions inaccessible, + # resulting in "Error in unload(pkg) : internal error -3 in R_decompress1". + # If we simply force them first, then they will remain available for use + # later. + if (pkg$package == "devtools") { + eapply(ns_env(pkg), force, all.names = TRUE) + } # If the package was loaded with devtools, any s4 classes that were created # by the package need to be removed in a special way. @@ -73,38 +78,6 @@ unload <- function(pkg = ".") { unload_dll(pkg) } -unregister_S3_methods <- function(ns) { - S3_methods <- getNamespaceInfo(ns, "S3methods") - - unregister <- function(name, class, method) { - # This code was adapted from the .registerS3method internal function of - # base::registerS3methods - # https://github.com/wch/r-source/blob/05b76baa411afd3e9d0f3fc3c09a9a252a0a9100/src/library/base/R/namespace.R#L1398-L1426 - env <- - if (!is.na(x <- .knownS3Generics[name])) { - asNamespace(x) - } else { - if(is.null(genfun <- get0(name, envir = ns))) { - stop(sprintf("object '%s' not found while unloading namespace '%s'", - name, getNamespaceName(ns)), call. = FALSE) - } - if(.isMethodsDispatchOn() && methods::is(genfun, "genericFunction")) { - genfun <- genfun@default # nearly always, the S3 generic - } - if (typeof(genfun) == "closure") { - environment(genfun) - } else { - baseenv() - } - } - table <- get(".__S3MethodsTable__.", envir = env, inherits = FALSE) - rm(list = method, envir = table) - } - for (i in seq_len(NROW(S3_methods))) { - unregister(S3_methods[i, 1], S3_methods[i, 2], S3_methods[i, 3]) - } -} - # This unloads dlls loaded by either library() or load_all() unload_dll <- function(pkg = ".") { pkg <- as.package(pkg) From 6d760c5bf903294bee4aaf3dfc6f01f2e2cac51e Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Wed, 23 Dec 2015 17:30:51 -0500 Subject: [PATCH 3/4] Add comment explaining need to force promises --- R/install.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/install.r b/R/install.r index 936ac6373..eba437825 100644 --- a/R/install.r +++ b/R/install.r @@ -63,6 +63,9 @@ install <- function(pkg = ".", reload = TRUE, quick = FALSE, local = TRUE, pkg <- as.package(pkg) check_build_tools(pkg) + # Forcing all of the promises for the current namespace now will avoid lazy-load + # errors when the new package is installed overtop the old one. + # https://stat.ethz.ch/pipermail/r-devel/2015-December/072150.html if (is_loaded(pkg)) { eapply(ns_env(pkg), force, all.names = TRUE) } From d96101f163916162a81a4f12f820f4849917f4e4 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Thu, 24 Dec 2015 08:32:19 -0500 Subject: [PATCH 4/4] Add note to NEWS.md --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 258662e37..50cbd05c0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # devtools 1.9.1.9000 +* Fix longstanding lazy load database corruption issues when reloading packages + which define S3 methods on generics from base or other packages (#1001, @jimhester). + * `document()` now only runs `update_collate()` once. * Bugfix for `Remotes: ` feature that prevented it from working if devtools was