Merge branch 'ns-registry'

Author: wch

NAMESPACE

@@ -91,3 +91,4 @@ importFrom(tools,package_dependencies)
 importFrom(tools,parse_Rd)
 importFrom(utils,install.packages)
 importFrom(whisker,whisker.render)
+useDynLib(devtools,nsreg)

R/metadata.r

@@ -18,7 +18,7 @@
 #' unload(devtest("load-hooks"))
 #' @export
 dev_meta <- function(name) {
-  ns <- .Internal(getRegisteredNamespace(as.name(name)))
+  ns <- get_namespace(as.name(name))
   if (is.null(ns)) {
     stop("Namespace not found for ", name, ". Is it loaded?")
   }
@@ -34,7 +34,7 @@ dev_meta <- function(name) {
 # 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)))
+  ns <- get_namespace(as.name(name))
 
   if (!is.null(ns$.__DEVTOOLS__)) {
     stop("devtools metadata for package ", name, " already exists.")

R/namespace-env.r

@@ -43,7 +43,9 @@ create_ns_env <- function(pkg = ".") {
   env
 }
 
-# This is taken directly from base::loadNamespace() in R 2.15.1
+# This is taken directly from base::loadNamespace() in R 2.15.1.
+# Except .Internal(registerNamespace(name, env)) is replaced by
+# register_namespace(name, env)
 makeNamespace <- function(name, version = NULL, lib = NULL) {
   impenv <- new.env(parent = .BaseNamespaceEnv, hash = TRUE)
   attr(impenv, "name") <- paste("imports", name, sep = ":")
@@ -62,7 +64,7 @@ makeNamespace <- function(name, version = NULL, lib = NULL) {
   setNamespaceInfo(env, "dynlibs", NULL)
   setNamespaceInfo(env, "S3methods", matrix(NA_character_, 0L, 3L))
   assign(".__S3MethodsTable__.", new.env(hash = TRUE, parent = baseenv()), envir = env)
-  .Internal(registerNamespace(name, env))
+  register_namespace(name, env)
   env
 }
 
@@ -139,3 +141,60 @@ is_loaded <- function(pkg = ".") {
   pkg <- as.package(pkg)
   pkg$package %in% loadedNamespaces()
 }
+
+
+# Returns the namespace registry
+#' @useDynLib devtools nsreg
+ns_registry <- function() {
+  .Call(nsreg)
+}
+
+
+# Register a namespace
+register_namespace <- function(name = NULL, env = NULL) {
+  # Be careful about what we allow
+  if (!is.character(name) || name == "" || length(name) != 1)
+    stop("'name' must be a non-empty character string.")
+
+  if (!is.environment(env))
+    stop("'env' must be an environment.")
+
+  if (name %in% loadedNamespaces())
+    stop("Namespace ", name, " is already registered.")
+
+  # Add the environment to the registry
+  nsr <- ns_registry()
+  nsr[[name]] <- env
+
+  env
+}
+
+
+# unregister a namespace - should be used only if unloadNamespace()
+# fails for some reason
+unregister_namespace <- function(name = NULL) {
+  # Be careful about what we allow
+  if (!is.character(name) || name == "" || length(name) != 1)
+    stop("'name' must be a non-empty character string.")
+
+  if (!(name %in% loadedNamespaces()))
+    stop(name, " is not a registered namespace.")
+
+  # Remove the item from the registry
+  rm(name, ns_registry())
+  invisible()
+}
+
+# This is similar to getNamespace(), except that getNamespace will load
+# the namespace if it's not already loaded. This function will not.
+# In R 2.16, a function called .getNamespace() will have the same effect
+# and this will no longer be necessary.
+get_namespace <- function(name) {
+  # Sometimes we'll be passed something like as.name(name), so make sure
+  # it's a string
+  name <- as.character(name)
+  if (!(name %in% loadedNamespaces()))
+    return(NULL)
+  else
+    return(getNamespace(name))
+}

R/reload.r

@@ -77,10 +77,10 @@ unload <- function(pkg = ".") {
   # to go away.
   # loadedNamespaces() and unloadNamespace() often don't work here
   # because things can be in a weird state.
-  if (!is.null(.Internal(getRegisteredNamespace(pkg$package)))) {
+  if (!is.null(get_namespace(pkg$package))) {
     message("unloadNamespace(\"", pkg$package,
       "\") not successful. Forcing unload.")
-    .Internal(unregisterNamespace(pkg$package))
+    unregister_namespace(pkg$package)
   }
 
   # Clear so that loading the package again will re-read all files
@@ -95,6 +95,14 @@ unload <- function(pkg = ".") {
 unload_dll <- function(pkg = ".") {
   pkg <- as.package(pkg)
 
+  # Special case for devtools - don't unload DLL because we need to be able
+  # to access nsreg() in the DLL in order to run makeNamespace. This means
+  # that changes to compiled code in devtools can't be reloaded with
+  # load_all -- it requires a reinstallation.
+  if (pkg$package == "devtools") {
+    return(invisible())
+  }
+
   pkglibs <- loaded_dlls(pkg)
 
   for (lib in pkglibs) {

src/devtools.c

@@ -0,0 +1,6 @@
+#include <R.h>
+#include <Rdefines.h>
+
+SEXP nsreg() {
+  return R_NamespaceRegistry;
+}