1#' Return the namespace environment for a package. 2#' 3#' Contains all (exported and non-exported) objects, and is a descendant of 4#' `R_GlobalEnv`. The hierarchy is `<namespace:pkg>`, 5#' `<imports:pkg>`, `<namespace:base>`, and then 6#' `R_GlobalEnv`. 7#' 8#' If the package is not loaded, this function returns `NULL`. 9#' 10#' @param package package name. 11#' @keywords internal 12#' @seealso [pkg_env()] for the attached environment that 13#' contains the exported objects. 14#' @seealso [imports_env()] for the environment that contains 15#' imported objects for the package. 16#' @export 17ns_env <- function(package) { 18 if (!is_loaded(package)) return(NULL) 19 20 asNamespace(package) 21} 22 23ns_path <- function(package) { 24 ns <- asNamespace(package) 25 if (isBaseNamespace(ns)) 26 return(path.package(package)) 27 getNamespaceInfo(ns, "path") 28} 29 30# Create the namespace environment for a package 31create_ns_env <- function(path = ".") { 32 path <- pkg_path(path) 33 package <- pkg_name(path) 34 version <- pkg_version(path) 35 36 if (is_loaded(package)) { 37 stop("Namespace for ", package, " already exists.") 38 } 39 40 env <- makeNamespace(package, version) 41 methods::setPackageName(package, env) 42 # Create devtools metadata in namespace 43 create_dev_meta(package) 44 45 setNamespaceInfo(env, "path", path) 46 setup_ns_imports(path) 47 48 env 49} 50 51# This is taken directly from base::loadNamespace() 52# https://github.com/wch/r-source/blob/tags/R-3-3-0/src/library/base/R/namespace.R#L235-L258 53onload_assign("makeNamespace", 54 eval( 55 modify_lang( 56 extract_lang(body(loadNamespace), 57 58 # Find makeNamespace definition 59 comp_lang, y = quote(makeNamespace <- NULL), idx = 1:2)[[3]], 60 61 # Replace call to .Internal(registerNamespace()) is replaced by a call to 62 # register_namespace 63 function(x) { 64 if (comp_lang(x, quote(.Internal(registerNamespace(name, env))))) { 65 quote(register_namespace(name, env)) 66 } else { 67 x 68 } 69 })) 70) 71 72# Read the NAMESPACE file and set up the imports metdata. 73# (which is stored in .__NAMESPACE__.) 74setup_ns_imports <- function(path = ".") { 75 path <- pkg_path(path) 76 package <- pkg_name(path) 77 78 nsInfo <- parse_ns_file(path) 79 setNamespaceInfo(package, "imports", nsInfo$imports) 80} 81 82 83# Read the NAMESPACE file and set up the exports metdata. This must be 84# run after all the objects are loaded into the namespace because 85# namespaceExport throw errors if the objects are not present. 86setup_ns_exports <- function(path = ".", export_all = FALSE, export_imports = export_all) { 87 path <- pkg_path(path) 88 package <- pkg_name(path) 89 90 nsInfo <- parse_ns_file(path) 91 nsenv <- ns_env(package) 92 93 if (export_all) { 94 exports <- ls(nsenv, all.names = TRUE) 95 # Make sure to re-export objects that are imported from other packages but 96 # not copied. 97 exports <- union(exports, nsInfo$exports) 98 99 # if export_imports export all imports as well 100 if (export_imports) { 101 exports <- c(exports, ls(imports_env(package), all.names = TRUE)) 102 } 103 104 # List of things to ignore is from loadNamespace. There are also a 105 # couple things to ignore from devtools. 106 ignoreidx <- exports %in% c( ".__NAMESPACE__.", 107 ".__S3MethodsTable__.", ".packageName", ".First.lib", ".onLoad", 108 ".onAttach", ".conflicts.OK", ".noGenerics", 109 ".__DEVTOOLS__", ".cache") 110 exports <- exports[!ignoreidx] 111 112 } else { 113 # This code is from base::loadNamespace 114 exports <- nsInfo$exports 115 for (p in nsInfo$exportPatterns) 116 exports <- c(ls(nsenv, pattern = p, all.names = TRUE), exports) 117 } 118 # Don't try to export objects that are missing from the namespace and imports 119 ns_and_imports <- c(ls(nsenv, all.names = TRUE), 120 ls(imports_env(package), all.names = TRUE)) 121 extra_exports <- setdiff(exports, ns_and_imports) 122 123 if (length(extra_exports) > 0) { 124 warning("Objects listed as exports, but not present in namespace: ", 125 paste(extra_exports, collapse = ", ")) 126 exports <- intersect(ns_and_imports, exports) 127 } 128 129 # Add any S4 methods or classes, this needs to be done after checking for 130 # missing exports as S4 methods with generics imported from other packages 131 # are not defined in the namespace. 132 exports <- add_classes_to_exports(ns = nsenv, package = package, 133 exports = exports, nsInfo = nsInfo) 134 135 # Update the exports metadata for the namespace with base::namespaceExport 136 # It will throw warnings if objects are already listed in the exports 137 # metadata, so catch those warnings and ignore them. 138 suppressWarnings(namespaceExport(nsenv, exports)) 139 140 invisible() 141} 142 143# Lookup S4 classes for export 144# 145# This function uses code from base::loadNamespace. Previously this code was 146# copied directly, now it is dynamically looked up instead, to prevent drift as 147# base::loadNamespace changes. 148onload_assign("add_classes_to_exports", 149 { 150 pattern <- if (getRversion() >= "4.1.0") { 151 quote(if (.isMethodsDispatchOn() && hasS4m && !identical(package, "methods")) NULL) 152 } else { 153 quote(if (.isMethodsDispatchOn() && .hasS4MetaData(ns) && !identical(package, "methods")) NULL) 154 } 155 make_function(alist(ns =, package =, exports =, nsInfo =), 156 call("{", 157 quote(lev <- 0L), 158 quote(hasS4m <- .hasS4MetaData(ns)), 159 extract_lang( 160 f = comp_lang, 161 y = pattern, 162 idx = c(1, 2), 163 modify_lang(body(base::loadNamespace), strip_internal_calls, "methods") 164 ), 165 quote(exports) 166 ), asNamespace("methods") 167 ) 168 } 169) 170 171#' Parses the NAMESPACE file for a package 172#' 173#' @inheritParams load_all 174#' @examples 175#' if (has_tests()) { 176#' parse_ns_file(pkgtest("testLoadHooks")) 177#' } 178#' @keywords internal 179#' @export 180parse_ns_file <- function(path = ".") { 181 path <- pkg_path(path) 182 183 parseNamespaceFile(basename(path), dirname(path), 184 mustExist = FALSE) 185} 186 187 188# Register the S3 methods for this package 189register_s3 <- function(path = ".") { 190 path <- pkg_path(path) 191 package <- pkg_name(path) 192 193 nsInfo <- parse_ns_file(path) 194 195 # Adapted from loadNamespace 196 try(registerS3methods(nsInfo$S3methods, package, ns_env(package))) 197} 198 199 200# Reports whether a package is loaded into a namespace. It may be 201# attached or not attached. 202is_loaded <- function(package) { 203 package %in% loadedNamespaces() 204} 205 206 207# Returns the namespace registry 208ns_registry <- function() { 209 (get(".Internal", envir = baseenv(), mode = "function"))(getNamespaceRegistry()) 210} 211# To avoid a note about getNamespaceRegistry being missing 212utils::globalVariables("getNamespaceRegistry") 213 214# Register a namespace 215register_namespace <- function(name = NULL, env = NULL) { 216 # Be careful about what we allow 217 if (!is.character(name) || name == "" || length(name) != 1) 218 stop("'name' must be a non-empty character string.") 219 220 if (!is.environment(env)) 221 stop("'env' must be an environment.") 222 223 if (name %in% loadedNamespaces()) 224 stop("Namespace ", name, " is already registered.") 225 226 # Add the environment to the registry 227 nsr <- ns_registry() 228 nsr[[name]] <- env 229 230 env 231} 232 233 234# unregister a namespace - should be used only if unloadNamespace() 235# fails for some reason 236unregister_namespace <- function(name = NULL) { 237 # Be careful about what we allow 238 if (!is.character(name) || name == "" || length(name) != 1) 239 stop("'name' must be a non-empty character string.") 240 241 if (!(name %in% loadedNamespaces())) 242 stop(name, " is not a registered namespace.") 243 244 # Force all bindings of the namespace in case of dangling 245 # references. If lazy bindings are forced after the namespace is 246 # unloaded, it might lead to decompress errors if unloaded or to 247 # inconsistencies if reloaded (the bindings are resolved in the new 248 # namespace). 249 eapply(ns_env(name), force, all.names = TRUE) 250 251 # Remove the item from the registry 252 do.call(rm, args = list(name, envir = ns_registry())) 253 invisible() 254} 255 256unregister_methods <- function(package) { 257 # Unloading S3 methods manually avoids lazy-load errors when the new 258 # package is loaded overtop the old one. It also prevents removed 259 # methods from staying registered. 260 s3_unregister(package) 261 262 # S4 classes that were created by the package need to be removed in a special way. 263 remove_s4_classes(package) 264} 265