From 77c0d4ff6a080f5a0d6179a93f856615b9cb005c Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 16:35:23 -0500 Subject: [PATCH 01/22] Split into namespace, pakage and imports env files --- DESCRIPTION | 3 +- R/imports-env.r | 31 +++++++++++++ R/{namespace.r => namespace-env.r} | 59 ++++++++++++++---------- R/package-env.r | 73 +++++++----------------------- 4 files changed, 86 insertions(+), 80 deletions(-) create mode 100644 R/imports-env.r rename R/{namespace.r => namespace-env.r} (74%) diff --git a/DESCRIPTION b/DESCRIPTION index ed701f2d2..51a728f2a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,7 +56,6 @@ Collate: 'with.r' 'install-bitbucket.r' 'path.r' - 'namespace.r' 'reload-devtools.r' 'run-loadhooks.r' 'env-utils.r' @@ -68,3 +67,5 @@ Collate: 'compile.r' 'load-dll.r' 'utils.r' + 'imports-env.r' + 'namespace-env.r' diff --git a/R/imports-env.r b/R/imports-env.r new file mode 100644 index 000000000..6a288d97c --- /dev/null +++ b/R/imports-env.r @@ -0,0 +1,31 @@ + +#' Package imports environment +#' Contains objects imported from other packages. Is the parent of the +#' package namespace environment, and is a child of , +#' which is a child of R_GlobalEnv, +#' @export +imports_env <- function(pkg = NULL) { + pkg <- as.package(pkg) + + if (!is.loaded_ns(pkg)) { + stop("Namespace environment must be created before accessing imports environment.") + } + + env <- parent.env(ns_env(pkg)) + + if (attr(env, 'name') != env_imports_name(pkg)) { + stop("Imports environment does not have attribute 'name' with value ", + env_imports_name(pkg), + ". This probably means that the namespace environment was not created correctly.") + } + + env +} + + +# Generate name of package imports environment +# Contains exported objects +env_imports_name <- function(pkg = NULL) { + pkg <- as.package(pkg) + paste("imports:", pkg$package, sep = "") +} diff --git a/R/namespace.r b/R/namespace-env.r similarity index 74% rename from R/namespace.r rename to R/namespace-env.r index fd0e84fea..ac04d4362 100644 --- a/R/namespace.r +++ b/R/namespace-env.r @@ -1,3 +1,39 @@ +#' Generate a namespace environment for a package. +#' +#' Contains all (exported and non-exported) objects, and is a descendent of +#' \code{R_GlobalEnv}. The hieararchy is \code{}, +#' \code{}, \code{}, and then +#' \code{R_GlobalEnv}. +#' +#' @param pkg package description, can be path or package name. See +#' \code{\link{as.package}} for more information +#' @param create if namespace environment doesn't already exist, +#' create it? +#' @keywords programming +#' @export +ns_env <- function(pkg = NULL, create = FALSE) { + pkg <- as.package(pkg) + + if (!is.loaded_ns(pkg)) { + if (create) { + env <- makeNamespace(pkg$package) + setPackageName(pkg$package, env) + # Create devtools metadata in namespace + dev_meta(pkg$package, create = TRUE) + + setNamespaceInfo(env, "path", pkg$path) + setup_ns_imports(pkg) + } else { + return(NULL) + } + } else { + env <- asNamespace(pkg$package) + } + + env +} + + # This is taken directly from base::loadNamespace() in R 2.15.1 makeNamespace <- function(name, version = NULL, lib = NULL) { impenv <- new.env(parent = .BaseNamespaceEnv, hash = TRUE) @@ -65,29 +101,6 @@ parse_ns_file <- function(pkg) { } -# Create the package environment and copy over objects from the -# namespace environment -attach_ns <- function(pkg, export_all = TRUE) { - pkg <- as.package(pkg) - nsenv <- ns_env(pkg) - pkgenv <- pkg_env(pkg, create = TRUE) - - if (export_all) { - # Copy all the objects from namespace env to package env, so that they - # are visible in global env. - copy_env(nsenv, pkgenv, - ignore = c(".__NAMESPACE__.", ".__S3MethodsTable__.", - ".packageName", ".First.lib", ".onLoad", ".onAttach", - ".conflicts.OK", ".noGenerics")) - - } else { - # Export only the objects specified in NAMESPACE - # This code from base::attachNamespace - exports <- getNamespaceExports(nsenv) - importIntoEnv(pkgenv, exports, nsenv, exports) - } -} - register_s3 <- function(pkg) { pkg <- as.package(pkg) nsInfo <- parse_ns_file(pkg) diff --git a/R/package-env.r b/R/package-env.r index 8f09e6809..912345d09 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -1,36 +1,24 @@ -#' Generate a namespace environment for a package. -#' -#' Contains all (exported and non-exported) objects, and is a descendent of -#' \code{R_GlobalEnv}. The hieararchy is \code{}, -#' \code{}, \code{}, and then -#' \code{R_GlobalEnv}. -#' -#' @param pkg package description, can be path or package name. See -#' \code{\link{as.package}} for more information -#' @param create if namespace environment doesn't already exist, -#' create it? -#' @keywords programming -#' @export -ns_env <- function(pkg = NULL, create = FALSE) { +# Create the package environment and copy over objects from the +# namespace environment +attach_ns <- function(pkg, export_all = TRUE) { pkg <- as.package(pkg) + nsenv <- ns_env(pkg) + pkgenv <- pkg_env(pkg, create = TRUE) - if (!is.loaded_ns(pkg)) { - if (create) { - env <- makeNamespace(pkg$package) - setPackageName(pkg$package, env) - # Create devtools metadata in namespace - dev_meta(pkg$package, create = TRUE) + if (export_all) { + # Copy all the objects from namespace env to package env, so that they + # are visible in global env. + copy_env(nsenv, pkgenv, + ignore = c(".__NAMESPACE__.", ".__S3MethodsTable__.", + ".packageName", ".First.lib", ".onLoad", ".onAttach", + ".conflicts.OK", ".noGenerics")) - setNamespaceInfo(env, "path", pkg$path) - setup_ns_imports(pkg) - } else { - return(NULL) - } } else { - env <- asNamespace(pkg$package) + # Export only the objects specified in NAMESPACE + # This code from base::attachNamespace + exports <- getNamespaceExports(nsenv) + importIntoEnv(pkgenv, exports, nsenv, exports) } - - env } @@ -66,28 +54,6 @@ pkg_env <- function(pkg = NULL, create = FALSE) { as.environment(name) } -#' Package imports environment -#' Contains objects imported from other packages. Is the parent of the -#' package namespace environment, and is a child of , -#' which is a child of R_GlobalEnv, -#' @export -imports_env <- function(pkg = NULL) { - pkg <- as.package(pkg) - - if (!is.loaded_ns(pkg)) { - stop("Namespace environment must be created before accessing imports environment.") - } - - env <- parent.env(ns_env(pkg)) - - if (attr(env, 'name') != env_imports_name(pkg)) { - stop("Imports environment does not have attribute 'name' with value ", - env_imports_name(pkg), - ". This probably means that the namespace environment was not created correctly.") - } - - env -} #' Detach development environment #' @keywords internal @@ -98,6 +64,7 @@ clear_pkg_env <- function(pkg = NULL) { } } + # Generate name of package environment # Contains exported objects env_pkg_name <- function(pkg = NULL) { @@ -105,12 +72,6 @@ env_pkg_name <- function(pkg = NULL) { paste("package:", pkg$package, sep = "") } -# Generate name of package imports environment -# Contains exported objects -env_imports_name <- function(pkg = NULL) { - pkg <- as.package(pkg) - paste("imports:", pkg$package, sep = "") -} base_env <- function(pkg) { new.env(parent = emptyenv()) From a4b7bc62dc54b3c5ca3f929716d69a1766b3b1dc Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 16:37:27 -0500 Subject: [PATCH 02/22] Rename env_name functions for consistency --- R/imports-env.r | 7 +++---- R/load.r | 3 ++- R/package-env.r | 4 ++-- R/reload.r | 2 +- inst/tests/test-namespace.r | 2 +- 5 files changed, 9 insertions(+), 9 deletions(-) diff --git a/R/imports-env.r b/R/imports-env.r index 6a288d97c..18e1e1d54 100644 --- a/R/imports-env.r +++ b/R/imports-env.r @@ -1,4 +1,3 @@ - #' Package imports environment #' Contains objects imported from other packages. Is the parent of the #' package namespace environment, and is a child of , @@ -13,9 +12,9 @@ imports_env <- function(pkg = NULL) { env <- parent.env(ns_env(pkg)) - if (attr(env, 'name') != env_imports_name(pkg)) { + if (attr(env, 'name') != imports_env_name(pkg)) { stop("Imports environment does not have attribute 'name' with value ", - env_imports_name(pkg), + imports_env_name(pkg), ". This probably means that the namespace environment was not created correctly.") } @@ -25,7 +24,7 @@ imports_env <- function(pkg = NULL) { # Generate name of package imports environment # Contains exported objects -env_imports_name <- function(pkg = NULL) { +imports_env_name <- function(pkg = NULL) { pkg <- as.package(pkg) paste("imports:", pkg$package, sep = "") } diff --git a/R/load.r b/R/load.r index ea0fbaa49..b5bd34770 100644 --- a/R/load.r +++ b/R/load.r @@ -104,6 +104,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, # Set up the namespace environment ---------------------------------- + # This mimics the procedure in loadNamespace nsenv <- ns_env(pkg, create = TRUE) out <- list(env = nsenv) @@ -134,5 +135,5 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, is.locked <- function(pkg = NULL) { - environmentIsLocked(as.environment(env_pkg_name(pkg))) + environmentIsLocked(as.environment(pkg_env_name(pkg))) } diff --git a/R/package-env.r b/R/package-env.r index 912345d09..ebb5e6d2b 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -39,7 +39,7 @@ attach_ns <- function(pkg, export_all = TRUE) { #' @export pkg_env <- function(pkg = NULL, create = FALSE) { pkg <- as.package(pkg) - name <- env_pkg_name(pkg) + name <- pkg_env_name(pkg) if (!is.loaded_pkg(pkg)) { if (create) { @@ -67,7 +67,7 @@ clear_pkg_env <- function(pkg = NULL) { # Generate name of package environment # Contains exported objects -env_pkg_name <- function(pkg = NULL) { +pkg_env_name <- function(pkg = NULL) { pkg <- as.package(pkg) paste("package:", pkg$package, sep = "") } diff --git a/R/reload.r b/R/reload.r index 5ea4c1e5c..f2dad3392 100644 --- a/R/reload.r +++ b/R/reload.r @@ -32,7 +32,7 @@ reload <- function(pkg = NULL) { # Reports whether a package is loaded and attached is.loaded_pkg <- function(pkg = NULL) { - env_pkg_name(pkg) %in% search() + pkg_env_name(pkg) %in% search() } # Reports whether a package is loaded into a namespace. It may be diff --git a/inst/tests/test-namespace.r b/inst/tests/test-namespace.r index c6836d829..225bdfdb4 100644 --- a/inst/tests/test-namespace.r +++ b/inst/tests/test-namespace.r @@ -112,6 +112,6 @@ test_that("unload() removes package environments from search", { # This is what makes the objects inaccessible from global env expect_false(is_ancestor_env(pkgenv, .GlobalEnv)) # Another check of same thing - expect_false(env_pkg_name("namespace") %in% search()) + expect_false(pkg_env_name("namespace") %in% search()) }) From 83afec3836e66c107efca7dc717b27729229874e Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 16:54:42 -0500 Subject: [PATCH 03/22] ns_env: add separate create_ns_env function --- R/load.r | 5 +++-- R/namespace-env.r | 39 +++++++++++++++++++++------------------ 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/R/load.r b/R/load.r index b5bd34770..c2645325e 100644 --- a/R/load.r +++ b/R/load.r @@ -105,9 +105,10 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, # Set up the namespace environment ---------------------------------- # This mimics the procedure in loadNamespace - nsenv <- ns_env(pkg, create = TRUE) - out <- list(env = nsenv) + if (!is.loaded_ns(pkg)) create_ns_env(pkg) + + out <- list(env = ns_env(pkg)) # Load dependencies into the imports environment load_imports(pkg) diff --git a/R/namespace-env.r b/R/namespace-env.r index ac04d4362..bb77a2198 100644 --- a/R/namespace-env.r +++ b/R/namespace-env.r @@ -7,33 +7,36 @@ #' #' @param pkg package description, can be path or package name. See #' \code{\link{as.package}} for more information -#' @param create if namespace environment doesn't already exist, -#' create it? #' @keywords programming #' @export -ns_env <- function(pkg = NULL, create = FALSE) { +ns_env <- function(pkg = NULL) { pkg <- as.package(pkg) - if (!is.loaded_ns(pkg)) { - if (create) { - env <- makeNamespace(pkg$package) - setPackageName(pkg$package, env) - # Create devtools metadata in namespace - dev_meta(pkg$package, create = TRUE) - - setNamespaceInfo(env, "path", pkg$path) - setup_ns_imports(pkg) - } else { - return(NULL) - } - } else { - env <- asNamespace(pkg$package) + if (!is.loaded_ns(pkg)) return(NULL) + + asNamespace(pkg$package) +} + + +# Create the namespace environment for a package +create_ns_env <- function(pkg = NULL) { + pkg <- as.package(pkg) + + if (is.loaded_ns(pkg)) { + stop("Namespace for ", pkg$package, " already exists.") } + env <- makeNamespace(pkg$package) + setPackageName(pkg$package, env) + # Create devtools metadata in namespace + dev_meta(pkg$package, create = TRUE) + + setNamespaceInfo(env, "path", pkg$path) + setup_ns_imports(pkg) + env } - # This is taken directly from base::loadNamespace() in R 2.15.1 makeNamespace <- function(name, version = NULL, lib = NULL) { impenv <- new.env(parent = .BaseNamespaceEnv, hash = TRUE) From a7de85417813ad59f4cd36ee57aad3aa8e9f74bf Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:08:24 -0500 Subject: [PATCH 04/22] Use separate attach_ns and export_ns functions --- R/load.r | 8 +++++--- R/package-env.r | 38 +++++++++++++++++++++----------------- 2 files changed, 26 insertions(+), 20 deletions(-) diff --git a/R/load.r b/R/load.r index c2645325e..9ad554892 100644 --- a/R/load.r +++ b/R/load.r @@ -125,9 +125,11 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, run_onload(pkg) # Set up the package environment ------------------------------------ - # Create the package environment and copy over objects from the - # namespace environment. - attach_ns(pkg, export_all) + # Create the package environment if needed + if (!is.loaded_pkg(pkg)) attach_ns(pkg) + + # Copy over objects from the namespace environment + export_ns(pkg, export_all) run_onattach(pkg) diff --git a/R/package-env.r b/R/package-env.r index ebb5e6d2b..9da617423 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -1,9 +1,23 @@ -# Create the package environment and copy over objects from the -# namespace environment -attach_ns <- function(pkg, export_all = TRUE) { +# Create the package environment where objects will be copied to +attach_ns <- function(pkg) { pkg <- as.package(pkg) nsenv <- ns_env(pkg) - pkgenv <- pkg_env(pkg, create = TRUE) + + if (is.loaded_pkg(pkg)) { + stop("Package ", pkg$package, " is already attached.") + } + + # This should be similar to attachNamespace + pkgenv <- attach(new.env(parent = emptyenv()), name = pkg_env_name(pkg)) + attr(pkgenv, "path") <- getNamespaceInfo(nsenv, "path") +} + + +# Copy over the objects from the namespace env to the package env +export_ns <- function(pkg, export_all = TRUE) { + pkg <- as.package(pkg) + nsenv <- ns_env(pkg) + pkgenv <- pkg_env(pkg) if (export_all) { # Copy all the objects from namespace env to package env, so that they @@ -22,7 +36,7 @@ attach_ns <- function(pkg, export_all = TRUE) { } -#' Generate a package environment +#' Return package environment #' #' This is an environment like \code{}. It is attached, #' so it is an ancestor of \code{R_GlobalEnv}. @@ -34,22 +48,12 @@ attach_ns <- function(pkg, export_all = TRUE) { #' #' @param pkg package description, can be path or package name. See #' \code{\link{as.package}} for more information -#' @param create if package environment doesn't already exist, -#' create it? #' @export -pkg_env <- function(pkg = NULL, create = FALSE) { +pkg_env <- function(pkg = NULL) { pkg <- as.package(pkg) name <- pkg_env_name(pkg) - if (!is.loaded_pkg(pkg)) { - if (create) { - # This should be similar to attachNamespace - pkgenv <- attach(new.env(parent = emptyenv()), name = name) - attr(pkgenv, "path") <- pkg$path - } else { - return(NULL) - } - } + if (!is.loaded_pkg(pkg)) return(NULL) as.environment(name) } From 24c5be36554b60022a83a697ed6237744fc9e02a Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:12:23 -0500 Subject: [PATCH 05/22] Rename is.loaded_ns => is_loaded, and is.loaded_pkg => is_attached --- R/imports-env.r | 3 ++- R/load.r | 6 +++--- R/namespace-env.r | 4 ++-- R/package-env.r | 6 +++--- R/reload.r | 6 +++--- inst/tests/test-namespace.r | 4 ++-- 6 files changed, 15 insertions(+), 14 deletions(-) diff --git a/R/imports-env.r b/R/imports-env.r index 18e1e1d54..ddb303ba0 100644 --- a/R/imports-env.r +++ b/R/imports-env.r @@ -1,4 +1,5 @@ #' Package imports environment +#' #' Contains objects imported from other packages. Is the parent of the #' package namespace environment, and is a child of , #' which is a child of R_GlobalEnv, @@ -6,7 +7,7 @@ imports_env <- function(pkg = NULL) { pkg <- as.package(pkg) - if (!is.loaded_ns(pkg)) { + if (!is_loaded(pkg)) { stop("Namespace environment must be created before accessing imports environment.") } diff --git a/R/load.r b/R/load.r index 9ad554892..708f09478 100644 --- a/R/load.r +++ b/R/load.r @@ -85,7 +85,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, } # If installed version of package loaded, unload it - if (is.loaded_ns(pkg) && is.null(dev_meta(pkg$package))) { + if (is_loaded(pkg) && is.null(dev_meta(pkg$package))) { unload(pkg) } @@ -106,7 +106,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, # Set up the namespace environment ---------------------------------- # This mimics the procedure in loadNamespace - if (!is.loaded_ns(pkg)) create_ns_env(pkg) + if (!is_loaded(pkg)) create_ns_env(pkg) out <- list(env = ns_env(pkg)) @@ -126,7 +126,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, # Set up the package environment ------------------------------------ # Create the package environment if needed - if (!is.loaded_pkg(pkg)) attach_ns(pkg) + if (!is_attached(pkg)) attach_ns(pkg) # Copy over objects from the namespace environment export_ns(pkg, export_all) diff --git a/R/namespace-env.r b/R/namespace-env.r index bb77a2198..09160af80 100644 --- a/R/namespace-env.r +++ b/R/namespace-env.r @@ -12,7 +12,7 @@ ns_env <- function(pkg = NULL) { pkg <- as.package(pkg) - if (!is.loaded_ns(pkg)) return(NULL) + if (!is_loaded(pkg)) return(NULL) asNamespace(pkg$package) } @@ -22,7 +22,7 @@ ns_env <- function(pkg = NULL) { create_ns_env <- function(pkg = NULL) { pkg <- as.package(pkg) - if (is.loaded_ns(pkg)) { + if (is_loaded(pkg)) { stop("Namespace for ", pkg$package, " already exists.") } diff --git a/R/package-env.r b/R/package-env.r index 9da617423..c541ab7b0 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -3,7 +3,7 @@ attach_ns <- function(pkg) { pkg <- as.package(pkg) nsenv <- ns_env(pkg) - if (is.loaded_pkg(pkg)) { + if (is_attached(pkg)) { stop("Package ", pkg$package, " is already attached.") } @@ -53,7 +53,7 @@ pkg_env <- function(pkg = NULL) { pkg <- as.package(pkg) name <- pkg_env_name(pkg) - if (!is.loaded_pkg(pkg)) return(NULL) + if (!is_attached(pkg)) return(NULL) as.environment(name) } @@ -63,7 +63,7 @@ pkg_env <- function(pkg = NULL) { #' @keywords internal clear_pkg_env <- function(pkg = NULL) { - if (is.loaded_pkg(pkg)) { + if (is_attached(pkg)) { unload(pkg) } } diff --git a/R/reload.r b/R/reload.r index f2dad3392..2d2a38916 100644 --- a/R/reload.r +++ b/R/reload.r @@ -23,7 +23,7 @@ reload <- function(pkg = NULL) { pkg <- as.package(pkg) - if (is.loaded_pkg(pkg)) { + if (is_attached(pkg)) { message("Reloading installed ", pkg$package) unload(pkg) require(pkg$package, character.only = TRUE, quietly = TRUE) @@ -31,13 +31,13 @@ reload <- function(pkg = NULL) { } # Reports whether a package is loaded and attached -is.loaded_pkg <- function(pkg = NULL) { +is_attached <- function(pkg = NULL) { pkg_env_name(pkg) %in% search() } # Reports whether a package is loaded into a namespace. It may be # attached or not attached. -is.loaded_ns <- function(pkg = NULL) { +is_loaded <- function(pkg = NULL) { pkg <- as.package(pkg) pkg$package %in% loadedNamespaces() } diff --git a/inst/tests/test-namespace.r b/inst/tests/test-namespace.r index 225bdfdb4..72ff10343 100644 --- a/inst/tests/test-namespace.r +++ b/inst/tests/test-namespace.r @@ -102,8 +102,8 @@ test_that("unload() removes package environments from search", { unload(inst("MASS")) # Should report not loaded for package and namespace environments - expect_false(is.loaded_pkg("namespace")) - expect_false(is.loaded_ns("namespace")) + expect_false(is_attached("namespace")) + expect_false(is_loaded("namespace")) # R's asNamespace function should error expect_error(asNamespace("namespace")) From 2702697ca78eb9a4f6bd2464e3795cd4c47bc5e3 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:18:00 -0500 Subject: [PATCH 06/22] attach_ns: use NULL environment for attach() This is how it's done in attachNamespace. --- R/package-env.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/package-env.r b/R/package-env.r index c541ab7b0..84e481352 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -8,7 +8,7 @@ attach_ns <- function(pkg) { } # This should be similar to attachNamespace - pkgenv <- attach(new.env(parent = emptyenv()), name = pkg_env_name(pkg)) + pkgenv <- attach(NULL, name = pkg_env_name(pkg)) attr(pkgenv, "path") <- getNamespaceInfo(nsenv, "path") } From a442a6ea2ca18406fb723b95bb9d20aa8548c215 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:20:19 -0500 Subject: [PATCH 07/22] Remove unneeded function clear_pkg_env --- R/load.r | 2 +- R/package-env.r | 10 ---------- 2 files changed, 1 insertion(+), 11 deletions(-) diff --git a/R/load.r b/R/load.r index 708f09478..6e9ae25b1 100644 --- a/R/load.r +++ b/R/load.r @@ -94,7 +94,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, if (reset) { clear_cache() - clear_pkg_env(pkg) + if (is_loaded(pkg)) unload(pkg) } if (recompile) clean_dll(pkg) diff --git a/R/package-env.r b/R/package-env.r index 84e481352..d0dd77a2e 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -59,16 +59,6 @@ pkg_env <- function(pkg = NULL) { } -#' Detach development environment -#' @keywords internal -clear_pkg_env <- function(pkg = NULL) { - - if (is_attached(pkg)) { - unload(pkg) - } -} - - # Generate name of package environment # Contains exported objects pkg_env_name <- function(pkg = NULL) { From 9da601aa3a15334b6e1b8514b5694480fbbefca7 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:20:42 -0500 Subject: [PATCH 08/22] Remove unused function base_env --- R/package-env.r | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/package-env.r b/R/package-env.r index d0dd77a2e..c709aa235 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -65,8 +65,3 @@ pkg_env_name <- function(pkg = NULL) { pkg <- as.package(pkg) paste("package:", pkg$package, sep = "") } - - -base_env <- function(pkg) { - new.env(parent = emptyenv()) -} From d159c1d7ce128f87f981ec65e020e80669b54ae5 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:22:26 -0500 Subject: [PATCH 09/22] Move is_loaded and is_attached to different files --- R/namespace-env.r | 8 ++++++++ R/package-env.r | 6 ++++++ R/reload.r | 12 ------------ 3 files changed, 14 insertions(+), 12 deletions(-) diff --git a/R/namespace-env.r b/R/namespace-env.r index 09160af80..9e5f2a3fb 100644 --- a/R/namespace-env.r +++ b/R/namespace-env.r @@ -111,3 +111,11 @@ register_s3 <- function(pkg) { # Adapted from loadNamespace registerS3methods(nsInfo$S3methods, pkg$package, ns_env(pkg)) } + + +# Reports whether a package is loaded into a namespace. It may be +# attached or not attached. +is_loaded <- function(pkg = NULL) { + pkg <- as.package(pkg) + pkg$package %in% loadedNamespaces() +} diff --git a/R/package-env.r b/R/package-env.r index c709aa235..79f79088f 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -65,3 +65,9 @@ pkg_env_name <- function(pkg = NULL) { pkg <- as.package(pkg) paste("package:", pkg$package, sep = "") } + + +# Reports whether a package is loaded and attached +is_attached <- function(pkg = NULL) { + pkg_env_name(pkg) %in% search() +} diff --git a/R/reload.r b/R/reload.r index 2d2a38916..8c957dc25 100644 --- a/R/reload.r +++ b/R/reload.r @@ -30,18 +30,6 @@ reload <- function(pkg = NULL) { } } -# Reports whether a package is loaded and attached -is_attached <- function(pkg = NULL) { - pkg_env_name(pkg) %in% search() -} - -# Reports whether a package is loaded into a namespace. It may be -# attached or not attached. -is_loaded <- function(pkg = NULL) { - pkg <- as.package(pkg) - pkg$package %in% loadedNamespaces() -} - #' Unload a package #' #' @param pkg package description, can be path or package name. See From 56b2fb8762b006a0f537b84942923f1fb3d3a02c Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:22:53 -0500 Subject: [PATCH 10/22] Remove unused function is.locked --- R/load.r | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/load.r b/R/load.r index 6e9ae25b1..72b5a70b3 100644 --- a/R/load.r +++ b/R/load.r @@ -135,8 +135,3 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, invisible(out) } - - -is.locked <- function(pkg = NULL) { - environmentIsLocked(as.environment(pkg_env_name(pkg))) -} From 36a3405428d7c36feee85f86b71ba6b0cc9989af Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:27:41 -0500 Subject: [PATCH 11/22] Move load_imports and process_imports to different file --- R/imports-env.r | 50 +++++++++++++++++++++++++++++++++++++++++++++++ R/metadata.r | 23 +++++++++++++++------- R/namespace-env.r | 2 +- R/package-deps.r | 49 ---------------------------------------------- 4 files changed, 67 insertions(+), 57 deletions(-) diff --git a/R/imports-env.r b/R/imports-env.r index ddb303ba0..2023d2da5 100644 --- a/R/imports-env.r +++ b/R/imports-env.r @@ -29,3 +29,53 @@ imports_env_name <- function(pkg = NULL) { pkg <- as.package(pkg) paste("imports:", pkg$package, sep = "") } + + +#' Load all of the imports for a package +#' +#' The imported objects are copied to the imports environment, and are not +#' visible from R_GlobalEnv. This will automatically load (but not attach) +#' the dependency packages. +#' +#' @keywords internal +load_imports <- function(pkg = NULL, deps = c("depends", "imports")) { + pkg <- as.package(pkg) + + # Get data frame of dependency names and versions + deps <- lapply(pkg[deps], parse_deps) + deps <- Reduce(rbind, deps) + + if (is.null(deps) || nrow(deps) == 0) return(invisible()) + + # If we've already loaded imports, don't load again (until load_all + # is run with reset=TRUE). This is to avoid warnings when running + # process_imports() + if (length(ls(imports_env(pkg))) > 0) return(invisible(deps)) + + mapply(check_dep_version, deps$name, deps$version, deps$compare) + + process_imports(pkg) + + invisible(deps) +} + + +# Load imported objects +# The code in this function is taken from base::loadNamespace +process_imports <- function(pkg) { + nsInfo <- parse_ns_file(pkg) + ns <- ns_env(pkg) + lib.loc <- NULL + + ## process imports + for (i in nsInfo$imports) { + if (is.character(i)) + namespaceImport(ns, loadNamespace(i)) + else + namespaceImportFrom(ns, loadNamespace(i[[1L]]), i[[2L]]) + } + for(imp in nsInfo$importClasses) + namespaceImportClasses(ns, loadNamespace(imp[[1L]]), imp[[2L]]) + for(imp in nsInfo$importMethods) + namespaceImportMethods(ns, loadNamespace(imp[[1L]]), imp[[2L]]) +} diff --git a/R/metadata.r b/R/metadata.r index acdb9efa1..335da644c 100644 --- a/R/metadata.r +++ b/R/metadata.r @@ -3,8 +3,6 @@ #' If the package was not loaded with devtools, returns \code{NULL}. #' #' @param name The name of a loaded package -#' @param create If the metadata environment does not exist, create it? -#' For internal use only. #' @examples #' dev_meta("stats") # NULL #' @@ -26,12 +24,23 @@ dev_meta <- function(name, create = FALSE) { } if (is.null(ns$.__DEVTOOLS__)) { - if (create) { - ns$.__DEVTOOLS__ <- new.env(parent = ns) - } else { - return(NULL) - } + return(NULL) } ns$.__DEVTOOLS__ } + + +# Create the devtools metadata environment for a package. +# This should be run when packages are loaded by devtools. +create_dev_meta <- function(name) { + ns <- .Internal(getRegisteredNamespace(as.name(name))) + + if (!is.null(ns$.__DEVTOOLS__)) { + stop("devtools metadata for package ", name, " already exists.") + } + + ns$.__DEVTOOLS__ <- new.env(parent = ns) + + ns$.__DEVTOOLS__ +} diff --git a/R/namespace-env.r b/R/namespace-env.r index 9e5f2a3fb..8c8289913 100644 --- a/R/namespace-env.r +++ b/R/namespace-env.r @@ -29,7 +29,7 @@ create_ns_env <- function(pkg = NULL) { env <- makeNamespace(pkg$package) setPackageName(pkg$package, env) # Create devtools metadata in namespace - dev_meta(pkg$package, create = TRUE) + create_dev_meta(pkg$package) setNamespaceInfo(env, "path", pkg$path) setup_ns_imports(pkg) diff --git a/R/package-deps.r b/R/package-deps.r index 415042b77..9d56f6ac8 100644 --- a/R/package-deps.r +++ b/R/package-deps.r @@ -35,33 +35,6 @@ parse_deps <- function(string) { deps[names != "R", ] } -#' Load all of the imports for a package -#' -#' The imported objects are copied to the imports environment, and are not -#' visible from R_GlobalEnv. This will automatically load (but not attach) -#' the dependency packages. -#' -#' @keywords internal -load_imports <- function(pkg = NULL, deps = c("depends", "imports")) { - pkg <- as.package(pkg) - - # Get data frame of dependency names and versions - deps <- lapply(pkg[deps], parse_deps) - deps <- Reduce(rbind, deps) - - if (is.null(deps) || nrow(deps) == 0) return(invisible()) - - # If we've already loaded imports, don't load again (until load_all - # is run with reset=TRUE). This is to avoid warnings when running - # process_imports() - if (length(ls(imports_env(pkg))) > 0) return(invisible(deps)) - - mapply(check_dep_version, deps$name, deps$version, deps$compare) - - process_imports(pkg) - - invisible(deps) -} #' Check that the version of an imported package satisfies the requirements #' @@ -91,25 +64,3 @@ check_dep_version <- function(dep_name, dep_ver = NA, dep_compare = NA) { } return(TRUE) } - - - -# Load imported objects -# The code in this function is taken from base::loadNamespace -process_imports <- function(pkg) { - nsInfo <- parse_ns_file(pkg) - ns <- ns_env(pkg) - lib.loc <- NULL - - ## process imports - for (i in nsInfo$imports) { - if (is.character(i)) - namespaceImport(ns, loadNamespace(i)) - else - namespaceImportFrom(ns, loadNamespace(i[[1L]]), i[[2L]]) - } - for(imp in nsInfo$importClasses) - namespaceImportClasses(ns, loadNamespace(imp[[1L]]), imp[[2L]]) - for(imp in nsInfo$importMethods) - namespaceImportMethods(ns, loadNamespace(imp[[1L]]), imp[[2L]]) -} From 4e7f6b868200625982853f5f36f0dd1b97c0d13b Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:35:15 -0500 Subject: [PATCH 12/22] Edits to documentation --- R/imports-env.r | 7 ++++++- R/namespace-env.r | 9 ++++++++- R/package-env.r | 17 +++++++++++++---- R/reload.r | 2 +- 4 files changed, 28 insertions(+), 7 deletions(-) diff --git a/R/imports-env.r b/R/imports-env.r index 2023d2da5..32ea4c19a 100644 --- a/R/imports-env.r +++ b/R/imports-env.r @@ -2,7 +2,12 @@ #' #' Contains objects imported from other packages. Is the parent of the #' package namespace environment, and is a child of , -#' which is a child of R_GlobalEnv, +#' which is a child of R_GlobalEnv. +#' @keywords programming +#' @seealso \code{\link{ns_env}} for the namespace environment that +#' all the objects (exported and not exported). +#' @seealso \code{\link{pkg_env}} for the attached environment that contains +#' the exported objects. #' @export imports_env <- function(pkg = NULL) { pkg <- as.package(pkg) diff --git a/R/namespace-env.r b/R/namespace-env.r index 8c8289913..1efbdcc84 100644 --- a/R/namespace-env.r +++ b/R/namespace-env.r @@ -1,13 +1,19 @@ -#' Generate a namespace environment for a package. +#' Return the namespace environment for a package. #' #' Contains all (exported and non-exported) objects, and is a descendent of #' \code{R_GlobalEnv}. The hieararchy is \code{}, #' \code{}, \code{}, and then #' \code{R_GlobalEnv}. #' +#' If the package is not loaded, this function returns \code{NULL}. +#' #' @param pkg package description, can be path or package name. See #' \code{\link{as.package}} for more information #' @keywords programming +#' @seealso \code{\link{pkg_env}} for the attached environment that +#' contains the exported objects. +#' @seealso \code{\link{imports_env}} for the environment that contains +#' imported objects for the package. #' @export ns_env <- function(pkg = NULL) { pkg <- as.package(pkg) @@ -104,6 +110,7 @@ parse_ns_file <- function(pkg) { } +# Register the S3 methods for this package register_s3 <- function(pkg) { pkg <- as.package(pkg) nsInfo <- parse_ns_file(pkg) diff --git a/R/package-env.r b/R/package-env.r index 79f79088f..0c2606766 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -1,4 +1,4 @@ -# Create the package environment where objects will be copied to +# Create the package environment where exported objects will be copied to attach_ns <- function(pkg) { pkg <- as.package(pkg) nsenv <- ns_env(pkg) @@ -38,16 +38,25 @@ export_ns <- function(pkg, export_all = TRUE) { #' Return package environment #' -#' This is an environment like \code{}. It is attached, -#' so it is an ancestor of \code{R_GlobalEnv}. +#' This is an environment like \code{}. The package +#' environment contains the exported objects from a package. It is +#' attached, so it is an ancestor of \code{R_GlobalEnv}. #' #' When a package is loaded the normal way, using \code{\link{library}}, #' this environment contains only the exported objects from the #' namespace. However, when loaded with \code{\link{load_all}}, this -#' environment will contain all the objects from the namespace. +#' environment will contain all the objects from the namespace, unless +#' \code{load_all} is used with \code{export_all=FALSE}. +#' +#' If the package is not attached, this function returns \code{NULL}. #' #' @param pkg package description, can be path or package name. See #' \code{\link{as.package}} for more information +#' @keywords programming +#' @seealso \code{\link{ns_env}} for the namespace environment that +#' all the objects (exported and not exported). +#' @seealso \code{\link{imports_env}} for the environment that contains +#' imported objects for the package. #' @export pkg_env <- function(pkg = NULL) { pkg <- as.package(pkg) diff --git a/R/reload.r b/R/reload.r index 8c957dc25..008f99fa1 100644 --- a/R/reload.r +++ b/R/reload.r @@ -1,4 +1,4 @@ -#' Detach and reload package. +#' Unload and reload package. #' #' If the package is not loaded already, this does nothing. #' From 05626e341e2d26bc0ff2f9b5603a1befa39b1158 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:35:56 -0500 Subject: [PATCH 13/22] Re-roxygenize --- man/clear_pkg_env.Rd | 11 ----------- man/dev_meta.Rd | 3 --- man/import_dep.Rd | 25 ------------------------- man/imports_env.Rd | 21 +++++++++++++-------- man/ns_env.Rd | 18 +++++++++++++----- man/pkg_env.Rd | 27 +++++++++++++++++++-------- man/reload.Rd | 2 +- 7 files changed, 46 insertions(+), 61 deletions(-) delete mode 100644 man/clear_pkg_env.Rd delete mode 100644 man/import_dep.Rd diff --git a/man/clear_pkg_env.Rd b/man/clear_pkg_env.Rd deleted file mode 100644 index 90580529e..000000000 --- a/man/clear_pkg_env.Rd +++ /dev/null @@ -1,11 +0,0 @@ -\name{clear_pkg_env} -\alias{clear_pkg_env} -\title{Detach development environment} -\usage{ - clear_pkg_env(pkg = NULL) -} -\description{ - Detach development environment -} -\keyword{internal} - diff --git a/man/dev_meta.Rd b/man/dev_meta.Rd index c8f315af0..cb8954352 100644 --- a/man/dev_meta.Rd +++ b/man/dev_meta.Rd @@ -6,9 +6,6 @@ } \arguments{ \item{name}{The name of a loaded package} - - \item{create}{If the metadata environment does not exist, - create it? For internal use only.} } \description{ If the package was not loaded with devtools, returns diff --git a/man/import_dep.Rd b/man/import_dep.Rd deleted file mode 100644 index 5ae2f76fb..000000000 --- a/man/import_dep.Rd +++ /dev/null @@ -1,25 +0,0 @@ -\name{import_dep} -\alias{import_dep} -\title{Load a package in an "imports" environment.} -\usage{ - import_dep(pkg, dep_name, dep_ver = NA, dep_compare = NA) -} -\arguments{ - \item{pkg}{The package that is doing the importing} - - \item{dep_name}{The name of the package with objects to - import} - - \item{dep_ver}{The version of the package} - - \item{dep_compare}{The comparison operator to use to - check the version} -} -\description{ - All of the exported objects from the imported package are - copied to the imports environment for the development - package. This will automatically load (but not attach) - the imported package. -} -\keyword{internal} - diff --git a/man/imports_env.Rd b/man/imports_env.Rd index 203bb6b7f..f46c3df88 100644 --- a/man/imports_env.Rd +++ b/man/imports_env.Rd @@ -1,16 +1,21 @@ \name{imports_env} \alias{imports_env} -\title{Package imports environment -Contains objects imported from other packages. Is the parent of the -package namespace environment, and is a child of , -which is a child of R_GlobalEnv,} +\title{Package imports environment} \usage{ imports_env(pkg = NULL) } \description{ - Package imports environment Contains objects imported - from other packages. Is the parent of the package - namespace environment, and is a child of - , which is a child of R_GlobalEnv, + Contains objects imported from other packages. Is the + parent of the package namespace environment, and is a + child of , which is a child of + R_GlobalEnv. } +\seealso{ + \code{\link{ns_env}} for the namespace environment that + all the objects (exported and not exported). + + \code{\link{pkg_env}} for the attached environment that + contains the exported objects. +} +\keyword{programming} diff --git a/man/ns_env.Rd b/man/ns_env.Rd index 0311e5fb0..a1a42848a 100644 --- a/man/ns_env.Rd +++ b/man/ns_env.Rd @@ -1,15 +1,12 @@ \name{ns_env} \alias{ns_env} -\title{Generate a namespace environment for a package.} +\title{Return the namespace environment for a package.} \usage{ - ns_env(pkg = NULL, create = FALSE) + ns_env(pkg = NULL) } \arguments{ \item{pkg}{package description, can be path or package name. See \code{\link{as.package}} for more information} - - \item{create}{if namespace environment doesn't already - exist, create it?} } \description{ Contains all (exported and non-exported) objects, and is @@ -17,5 +14,16 @@ \code{}, \code{}, \code{}, and then \code{R_GlobalEnv}. } +\details{ + If the package is not loaded, this function returns + \code{NULL}. +} +\seealso{ + \code{\link{pkg_env}} for the attached environment that + contains the exported objects. + + \code{\link{imports_env}} for the environment that + contains imported objects for the package. +} \keyword{programming} diff --git a/man/pkg_env.Rd b/man/pkg_env.Rd index e20ca32f5..7e11198b7 100644 --- a/man/pkg_env.Rd +++ b/man/pkg_env.Rd @@ -1,25 +1,36 @@ \name{pkg_env} \alias{pkg_env} -\title{Generate a package environment} +\title{Return package environment} \usage{ - pkg_env(pkg = NULL, create = FALSE) + pkg_env(pkg = NULL) } \arguments{ \item{pkg}{package description, can be path or package name. See \code{\link{as.package}} for more information} - - \item{create}{if package environment doesn't already - exist, create it?} } \description{ - This is an environment like \code{}. It is - attached, so it is an ancestor of \code{R_GlobalEnv}. + This is an environment like \code{}. The + package environment contains the exported objects from a + package. It is attached, so it is an ancestor of + \code{R_GlobalEnv}. } \details{ When a package is loaded the normal way, using \code{\link{library}}, this environment contains only the exported objects from the namespace. However, when loaded with \code{\link{load_all}}, this environment will - contain all the objects from the namespace. + contain all the objects from the namespace, unless + \code{load_all} is used with \code{export_all=FALSE}. + + If the package is not attached, this function returns + \code{NULL}. +} +\seealso{ + \code{\link{ns_env}} for the namespace environment that + all the objects (exported and not exported). + + \code{\link{imports_env}} for the environment that + contains imported objects for the package. } +\keyword{programming} diff --git a/man/reload.Rd b/man/reload.Rd index 662efc635..fd46543c4 100644 --- a/man/reload.Rd +++ b/man/reload.Rd @@ -1,6 +1,6 @@ \name{reload} \alias{reload} -\title{Detach and reload package.} +\title{Unload and reload package.} \usage{ reload(pkg = NULL) } From 2a61c21996734c1bcbcac3d3c2c1a9cad4357821 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:47:55 -0500 Subject: [PATCH 14/22] Unload partially loaded package in test --- inst/tests/test-depend.r | 3 +++ 1 file changed, 3 insertions(+) diff --git a/inst/tests/test-depend.r b/inst/tests/test-depend.r index bdeb3674d..b526bd953 100644 --- a/inst/tests/test-depend.r +++ b/inst/tests/test-depend.r @@ -13,6 +13,9 @@ test_that("Warned about dependency versions", { test_that("Error on missing dependencies", { # Should give a warning about grid version expect_error(load_all("depend-missing"), "missingpackage not available") + + # Loading process will be partially done; unload it + unload("depend-missing") }) From a69db92b521787d0cb3ecb57d5d47ab315a1cd83 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 21:54:49 -0500 Subject: [PATCH 15/22] Add tests for dev_packages() --- inst/tests/test-metadata.r | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/inst/tests/test-metadata.r b/inst/tests/test-metadata.r index 1701dbf97..e7c0ac244 100644 --- a/inst/tests/test-metadata.r +++ b/inst/tests/test-metadata.r @@ -22,3 +22,29 @@ test_that("devtools metadata for load hooks", { test_that("NULL metadata for non-devtools-loaded packages", { expect_true(is.null(dev_meta("stats"))) }) + + +test_that("dev_packages() lists devtools-loaded packages", { + expect_false(any(c("namespace", "loadhooks") %in% dev_packages())) + expect_false("namespace" %in% dev_packages()) + expect_false("loadhooks" %in% dev_packages()) + + load_all("namespace") + expect_true("namespace" %in% dev_packages()) + expect_false("loadhooks" %in% dev_packages()) + + load_all("load-hooks") + expect_true("namespace" %in% dev_packages()) + expect_true("loadhooks" %in% dev_packages()) + + unload("namespace") + expect_false("namespace" %in% dev_packages()) + expect_true("loadhooks" %in% dev_packages()) + + unload("load-hooks") + expect_false("namespace" %in% dev_packages()) + expect_false("loadhooks" %in% dev_packages()) + + + expect_false("stats" %in% dev_packages()) +}) From e65fb8251550ffc182ca89faddb7b516ffbd6fba Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sat, 18 Aug 2012 22:00:37 -0500 Subject: [PATCH 16/22] Clean up side effects from loading test package --- inst/tests/load-hooks/R/a.r | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/inst/tests/load-hooks/R/a.r b/inst/tests/load-hooks/R/a.r index 18c8388d9..b260133c4 100644 --- a/inst/tests/load-hooks/R/a.r +++ b/inst/tests/load-hooks/R/a.r @@ -18,5 +18,8 @@ c <- 1 } .onUnload <- function(libpath) { - .GlobalEnv$.__loadhooks__ <- .GlobalEnv$.__loadhooks__ + 1 + # Increment this variable if it exists in the global env + if (exists(".__loadhooks__", .GlobalEnv)) { + .GlobalEnv$.__loadhooks__ <- .GlobalEnv$.__loadhooks__ + 1 + } } From 5df2391dea029ae583e8c2937a2092b185e0eb64 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sun, 19 Aug 2012 00:10:37 -0500 Subject: [PATCH 17/22] Better description for imports_env --- R/imports-env.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/imports-env.r b/R/imports-env.r index 32ea4c19a..8cb1697e2 100644 --- a/R/imports-env.r +++ b/R/imports-env.r @@ -1,4 +1,4 @@ -#' Package imports environment +#' Return imports environment for a package #' #' Contains objects imported from other packages. Is the parent of the #' package namespace environment, and is a child of , From fb3e34ce3888e240c7ffc0ffd64ccf82df27be9c Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sun, 19 Aug 2012 12:36:55 -0500 Subject: [PATCH 18/22] When export_all=TRUE, set up exports in namespace metadata Previously the export_all flag changed behavior when the objects were copied to the package environment. This change makes it instead set up the namespace exports metadata so that all the objects are (or aren't) listed there. Then all the objects listed in the exports metadata are copied over. --- R/load.r | 4 ++-- R/namespace-env.r | 24 ++++++++++++++++++------ R/package-env.r | 18 +++--------------- 3 files changed, 23 insertions(+), 23 deletions(-) diff --git a/R/load.r b/R/load.r index 72b5a70b3..5a8845e54 100644 --- a/R/load.r +++ b/R/load.r @@ -120,7 +120,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, # Set up the exports in the namespace metadata (this must happen after # the objects are loaded) - setup_ns_exports(pkg) + setup_ns_exports(pkg, export_all) run_onload(pkg) @@ -129,7 +129,7 @@ load_all <- function(pkg = NULL, reset = FALSE, recompile = FALSE, if (!is_attached(pkg)) attach_ns(pkg) # Copy over objects from the namespace environment - export_ns(pkg, export_all) + export_ns(pkg) run_onattach(pkg) diff --git a/R/namespace-env.r b/R/namespace-env.r index 1efbdcc84..a25f22328 100644 --- a/R/namespace-env.r +++ b/R/namespace-env.r @@ -78,14 +78,26 @@ setup_ns_imports <- function(pkg) { # Read the NAMESPACE file and set up the exports metdata. This must be # run after all the objects are loaded into the namespace because # namespaceExport throw errors if the objects are not present. -setup_ns_exports <- function(pkg) { +setup_ns_exports <- function(pkg, export_all = FALSE) { nsInfo <- parse_ns_file(pkg) - # This code is from base::loadNamespace - exports <- nsInfo$exports - for (p in nsInfo$exportPatterns) - exports <- c(ls(env, pattern = p, all.names = TRUE), exports) - + if (export_all) { + exports <- ls(ns_env(pkg), all.names = TRUE) + + # List of things to ignore is from loadNamespace. There are also a + # couple things to ignore from devtools. + ignoreidx <- exports %in% c( ".__NAMESPACE__.", + ".__S3MethodsTable__.", ".packageName", ".First.lib", ".onLoad", + ".onAttach", ".conflicts.OK", ".noGenerics", + ".__DEVTOOLS__", ".cache") + exports <- exports[!ignoreidx] + + } else { + # This code is from base::loadNamespace + exports <- nsInfo$exports + for (p in nsInfo$exportPatterns) + exports <- c(ls(env, pattern = p, all.names = TRUE), exports) + } # Update the exports metadata for the namespace with base::namespaceExport # It will throw warnings if objects are already listed in the exports # metadata, so catch those warnings and ignore them. diff --git a/R/package-env.r b/R/package-env.r index 0c2606766..dd5bc6995 100644 --- a/R/package-env.r +++ b/R/package-env.r @@ -14,25 +14,13 @@ attach_ns <- function(pkg) { # Copy over the objects from the namespace env to the package env -export_ns <- function(pkg, export_all = TRUE) { +export_ns <- function(pkg) { pkg <- as.package(pkg) nsenv <- ns_env(pkg) pkgenv <- pkg_env(pkg) - if (export_all) { - # Copy all the objects from namespace env to package env, so that they - # are visible in global env. - copy_env(nsenv, pkgenv, - ignore = c(".__NAMESPACE__.", ".__S3MethodsTable__.", - ".packageName", ".First.lib", ".onLoad", ".onAttach", - ".conflicts.OK", ".noGenerics")) - - } else { - # Export only the objects specified in NAMESPACE - # This code from base::attachNamespace - exports <- getNamespaceExports(nsenv) - importIntoEnv(pkgenv, exports, nsenv, exports) - } + exports <- getNamespaceExports(nsenv) + importIntoEnv(pkgenv, exports, nsenv, exports) } From 9fca98661d59f06fc07d27aeb84616c8c1448140 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sun, 19 Aug 2012 12:41:23 -0500 Subject: [PATCH 19/22] dev_meta: remove unused create arg --- R/metadata.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/metadata.r b/R/metadata.r index 335da644c..f5885810b 100644 --- a/R/metadata.r +++ b/R/metadata.r @@ -17,7 +17,7 @@ #' # Clean up. #' unload(devtest("load-hooks")) #' @export -dev_meta <- function(name, create = FALSE) { +dev_meta <- function(name) { ns <- .Internal(getRegisteredNamespace(as.name(name))) if (is.null(ns)) { stop("Namespace not found for ", name, ". Is it loaded?") From 858d5a7ef891535bd136be751a5fcb759343f034 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sun, 19 Aug 2012 13:03:08 -0500 Subject: [PATCH 20/22] Reorganize and update environment attribute tests --- inst/tests/test-attribute.r | 12 ------------ inst/tests/test-namespace.r | 33 +++++++++++++++++++++++++-------- 2 files changed, 25 insertions(+), 20 deletions(-) delete mode 100644 inst/tests/test-attribute.r diff --git a/inst/tests/test-attribute.r b/inst/tests/test-attribute.r deleted file mode 100644 index 4939b2236..000000000 --- a/inst/tests/test-attribute.r +++ /dev/null @@ -1,12 +0,0 @@ -context("Attribute") - -test_that("Package environment has correct 'path' attribute", { - load_all("namespace") - pkgenv <- as.environment("package:namespace") - - wd <- normalizePath(devtest("namespace")) - pkg_path <- attr(pkgenv, "path") - - expect_identical(wd, pkg_path) - unload("namespace") -}) diff --git a/inst/tests/test-namespace.r b/inst/tests/test-namespace.r index 72ff10343..69932b260 100644 --- a/inst/tests/test-namespace.r +++ b/inst/tests/test-namespace.r @@ -74,20 +74,16 @@ test_that("Namespace, imports, and package environments have correct hierarchy", load_all("namespace") pkgenv <- pkg_env("namespace") - nsenv <- ns_env("namespace") - imp_env <- imports_env("namespace") - + nsenv <- ns_env("namespace") + impenv <- imports_env("namespace") - expect_identical(parent_envs(nsenv)[[2]], imp_env) + expect_identical(parent_envs(nsenv)[[2]], impenv) expect_identical(parent_envs(nsenv)[[3]], .BaseNamespaceEnv) expect_identical(parent_envs(nsenv)[[4]], .GlobalEnv) # pkgenv should be an ancestor of the global environment expect_true(is_ancestor_env(pkgenv, .GlobalEnv)) - # Import environment should have name attribute - expect_equal(attr(imp_env, "name"), "imports:namespace") - unload("namespace") }) @@ -96,7 +92,6 @@ test_that("unload() removes package environments from search", { load_all("namespace") pkgenv <- pkg_env("namespace") nsenv <- ns_env("namespace") - imp_env <- imports_env("namespace") unload("namespace") unload(inst("compiler")) unload(inst("MASS")) @@ -115,3 +110,25 @@ test_that("unload() removes package environments from search", { expect_false(pkg_env_name("namespace") %in% search()) }) + + +test_that("Environments have the correct attributes", { + load_all("namespace") + pkgenv <- pkg_env("namespace") + impenv <- imports_env("namespace") + + # as.environment finds the same package environment + expect_identical(pkgenv, as.environment("package:namespace")) + + # Check name attribute of package environment + expect_identical(attr(pkgenv, "name"), "package:namespace") + + # Check path attribute of package environment + wd <- normalizePath(devtest("namespace")) + expect_identical(wd, attr(pkgenv, "path")) + + # Check name attribute of imports environment + expect_identical(attr(impenv, "name"), "imports:namespace") + + unload("namespace") +}) From 2394007ca4a6c2244fa9292f491f0b7db0c3f20f Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sun, 19 Aug 2012 13:08:05 -0500 Subject: [PATCH 21/22] Edits to tests --- inst/tests/test-dll.r | 9 +++++---- inst/tests/test-namespace.r | 20 ++++++++++++++------ 2 files changed, 19 insertions(+), 10 deletions(-) diff --git a/inst/tests/test-dll.r b/inst/tests/test-dll.r index 226bb2c77..fe99bfc84 100644 --- a/inst/tests/test-dll.r +++ b/inst/tests/test-dll.r @@ -55,16 +55,17 @@ test_that("load_all() compiles and loads DLLs", { # Loading again, and reloading - # Should not re-compile (don't have a proper test for it) + # Should not re-compile (don't have a proper test for this) load_all("dll-unload") expect_true(is.null(nulltest())) - # Should not re-compile (don't have a proper test for it) + # load_all when already loaded + # Should not re-compile (don't have a proper test for this) load_all("dll-unload") expect_true(is.null(nulltest())) - # Should re-compile (don't have a proper test for it) - load_all("dll-unload", reset = TRUE) + # Should re-compile (don't have a proper test for this) + load_all("dll-unload", recompile = TRUE) expect_true(is.null(nulltest())) unload("dll-unload") diff --git a/inst/tests/test-namespace.r b/inst/tests/test-namespace.r index 69932b260..b4e48bcba 100644 --- a/inst/tests/test-namespace.r +++ b/inst/tests/test-namespace.r @@ -12,17 +12,17 @@ is_ancestor_env <- function(e, x) { } -test_that("Package objects are visible from global environment", { +test_that("Exported objects are visible from global environment", { - # a is exported, b is not. With load_all(), they should by default - # both be visible in the global env. + # a is listed as an export in NAMESPACE, b is not. But with load_all(), + # they should both be visible in the global env. load_all("namespace") expect_equal(a, 1) expect_equal(b, 2) unload("namespace") - # With export_all = FALSE, only the exported object should be visible + # With export_all = FALSE, only the listed export should be visible # in the global env. load_all("namespace", export_all = FALSE) expect_equal(a, 1) @@ -30,7 +30,7 @@ test_that("Package objects are visible from global environment", { unload("namespace") }) -test_that("All package objects are loaded into namespace environment", { +test_that("All objects are loaded into namespace environment", { load_all("namespace") nsenv <- ns_env("namespace") expect_equal(nsenv$a, 1) @@ -39,14 +39,22 @@ test_that("All package objects are loaded into namespace environment", { }) -test_that("All package objects are copied to package environment", { +test_that("All objects are copied to package environment", { load_all("namespace") pkgenv <- pkg_env("namespace") expect_equal(pkgenv$a, 1) expect_equal(pkgenv$b, 2) unload("namespace") + + # With export_all = FALSE, only the listed export should be copied + load_all("namespace", export_all = FALSE) + pkgenv <- pkg_env("namespace") + expect_equal(pkgenv$a, 1) + expect_false(exists("b", envir = pkgenv)) + unload("namespace") }) + test_that("Unloading and reloading a package works", { load_all("namespace") expect_equal(a, 1) From 6533402a3bec12b5120acba975db467d8c3eee19 Mon Sep 17 00:00:00 2001 From: Winston Chang Date: Sun, 19 Aug 2012 13:23:48 -0500 Subject: [PATCH 22/22] Re-roxygenize --- man/dev_meta.Rd | 2 +- man/imports_env.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/man/dev_meta.Rd b/man/dev_meta.Rd index cb8954352..4fe29646f 100644 --- a/man/dev_meta.Rd +++ b/man/dev_meta.Rd @@ -2,7 +2,7 @@ \alias{dev_meta} \title{Return devtools metadata environment} \usage{ - dev_meta(name, create = FALSE) + dev_meta(name) } \arguments{ \item{name}{The name of a loaded package} diff --git a/man/imports_env.Rd b/man/imports_env.Rd index f46c3df88..383b36962 100644 --- a/man/imports_env.Rd +++ b/man/imports_env.Rd @@ -1,6 +1,6 @@ \name{imports_env} \alias{imports_env} -\title{Package imports environment} +\title{Return imports environment for a package} \usage{ imports_env(pkg = NULL) }