Merge pull request #213 from wch/shim

Replacement for system.file. Fixes #179

DESCRIPTION

@@ -83,3 +83,4 @@ Collate:
     'rcpp-attributes.r'
     'cran.r'
     'load-depends.r'
+    'shims.r'

NEWS

@@ -7,6 +7,12 @@ NEW FEATURES
 
 * Packages listed in depends are `require()`d (Fixes #161, #178, #192)
 
+* `load_all()` now inserts a special version of `system.file` into the package's
+  imports environment. This tries to simulate the behavior of
+  `base::system.file` but gives modified results because the directory structure
+  of installed packages and uninstalled source packages is different. (Fixes
+  #179)
+
 MINOR FEATURES
 
 * `check_cran` now downloads packages from cran.rstudio.com.

R/load.r

@@ -17,6 +17,8 @@
 #' the imports environment, which has the name attribute
 #' \code{imports:pkgname}. It is in turn is a child of
 #' \code{<namespace:base>}, which is a child of the global environment.
+#' (There is also a copy of the base namespace that is a child of the empty
+#' environment.)
 #'
 #' The package environment \code{<package:pkgname>} is an ancestor of the
 #' global environment. Normally when loading a package, the objects
@@ -31,6 +33,14 @@
 #' loading an installed package with \code{\link{library}}, and can be
 #' useful for checking for missing exports.
 #'
+#' \code{load_all} also inserts shim functions into the imports environment
+#' of the laded package. It presently adds a replacement version of
+#' \code{system.file} which returns different paths from
+#' \code{base::system.file}. This is needed because installed and uninstalled
+#' package sources have different directory structures. Note that this is not
+#' a perfect replacement for \code{base::system.file}.
+#'
+#'
 #' @param pkg package description, can be path or package name.  See
 #'   \code{\link{as.package}} for more information
 #' @param reset clear package environment and reset file cache before loading
@@ -113,6 +123,8 @@ load_all <- function(pkg = ".", reset = FALSE, recompile = FALSE,
   # Load dependencies
   load_depends(pkg)
   load_imports(pkg)
+  # Add shim objects
+  insert_shims(pkg)
 
   out$data <- load_data(pkg)
   out$code <- load_code(pkg)

R/shims.r

@@ -0,0 +1,60 @@
+# Insert shim objects into a package's imports environment
+#
+# @param pkg A path or package object
+insert_shims <- function(pkg = ".") {
+  pkg <- as.package(pkg)
+  assign("system.file", shim_system.file(pkg$package), pos = imports_env(pkg))
+}
+
+
+# This function is called with the name of the package being loaded, and returns
+# a replacement function for system.file.
+# @param pkg_name The name of the package loaded with load_all
+shim_system.file <- function(pkg_name) {
+
+  function(..., package = "base", lib.loc = NULL, mustWork = FALSE) {
+
+    # If package is not the same as pkg_name, pass through to base::system.file.
+    # If package is the same as the pkg_name (the package loaded with load_all)
+    # search for files a bit differently.
+    if (package != pkg_name) {
+      base::system.file(..., package = package, lib.loc = lib.loc,
+        mustWork = mustWork)
+
+    } else {
+      pkg_path <- find.package(pkg_name)
+
+      # First look in inst/
+      files_inst <- file.path(pkg_path, "inst", ...)
+      present_inst <- file.exists(files_inst)
+
+      # For any files that weren't present in inst/, look in the base path
+      files_top <- file.path(pkg_path, ...)
+      present_top <- file.exists(files_top)
+
+      # Merge them together. Here are the different possible conditions, and the
+      # desired result. NULL means to drop that element from the result.
+      #
+      # files_inst:   /inst/A  /inst/B  /inst/C  /inst/D
+      # present_inst:    T        T        F        F
+      # files_top:      /A       /B       /C       /D
+      # present_top:     T        F        T        F
+      # result:       /inst/A  /inst/B    /C       NULL
+      #
+      files <- files_top
+      files[present_inst] <- files_inst[present_inst]
+      # Drop cases where not present in either location
+      files <- files[present_inst | present_top]
+      if (length(files) > 0) {
+        files
+      } else {
+        ""
+      }
+      # Note that the behavior isn't exactly the same as base::system.file with an
+      # installed package; in that case, C and D would not be installed and so
+      # would not be found. Some other files (like DESCRIPTION, data/, etc) would
+      # be installed. To fully duplicate R's package-building and installation
+      # behavior would be complicated, so we'll just use this simple method.
+    }
+  }
+}

inst/tests/shim/A.txt

@@ -0,0 +1 @@
+file /A.txt

inst/tests/shim/C.txt

@@ -0,0 +1 @@
+file /C.txt

inst/tests/shim/DESCRIPTION

@@ -0,0 +1,8 @@
+Package: shim
+Title: Tools to make developing R code easier
+License: GPL-2
+Description: This package is for testing the devtools shim system.
+Author: Hadley <h.wickham@gmail.com>
+Maintainer: Hadley <h.wickham@gmail.com>
+Version: 0.1
+Collate: a.r

inst/tests/shim/NAMESPACE

@@ -0,0 +1 @@
+export(sysfile_wrap)

inst/tests/shim/R/a.r

@@ -0,0 +1,10 @@
+a <- 1
+
+# This is a wrapper for system.file
+# When this package is loaded with load_all, devtools should add a
+# replacement system.file function that behaves differently from
+# base::system.file. When installed and loaded, this just calls
+# base:system.file.
+sysfile_wrap <- function(...) {
+  system.file(...)
+}

inst/tests/shim/inst/A.txt

@@ -0,0 +1 @@
+file inst/A.txt

inst/tests/shim/inst/B.txt

@@ -0,0 +1 @@
+file inst/B.txt

inst/tests/test-shim.r

@@ -0,0 +1,98 @@
+context("shim")
+
+# Utility functions -----------------------------
+# Take file paths and split them into pieces
+expand_path <- function(path) {
+  strsplit(path, .Platform$file.sep)
+}
+
+# Return the last n elements of vector x
+last_n <- function(x, n = 1) {
+  len <- length(x)
+  x[(len-n+1):len]
+}
+
+
+# Tests -----------------------------------------
+
+test_that("Replacement system.file isn't visible in glabal env", {
+  load_all("shim")
+  expect_identical(get("system.file", pos = globalenv()), base::system.file)
+  unload("shim")
+})
+
+
+test_that("Replacement system.file returns correct values when used with load_all", {
+  load_all("shim")
+  shim_ns <- ns_env("shim")
+
+  # Make sure the version of system.file inserted into the namespace's imports
+  # isn't the same as base::system.file
+  expect_false(identical(
+    get("system.file", envir = shim_ns), base::system.file))
+
+  # The sysfile_wrap function just wraps system.file, and should return the
+  # modified values.
+  files <- sysfile_wrap(c("A.txt", "B.txt", "C.txt", "D.txt"), package = "shim")
+  files <- expand_path(files)
+  expect_true(all(last_n(files[[1]], 3) == c("shim", "inst", "A.txt")))
+  expect_true(all(last_n(files[[2]], 3) == c("shim", "inst", "B.txt")))
+  # Note that C.txt wouldn't be returned by base::system.file (see comments
+  # in shim_system.file for explanation)
+  expect_true(all(last_n(files[[3]], 2) == c("shim", "C.txt")))
+  # D.txt should be dropped
+  expect_equal(length(files), 3)
+
+  # If all files are not present, return ""
+  files <- sysfile_wrap("nonexistent", package = "shim")
+  expect_equal(files, "")
+
+  # Test packages outside shim - should just pass through to
+  # base::system.file
+  expect_identical(system.file("Meta", "Rd.rds", package = "stats"),
+    sysfile_wrap("Meta", "Rd.rds", package = "stats"))
+  expect_identical(system.file("INDEX", package = "stats"),
+    sysfile_wrap("INDEX", package = "stats"))
+  expect_identical(system.file("nonexistent", package = "stats"),
+    sysfile_wrap("nonexistent", package = "stats"))
+
+  unload("shim")
+})
+
+
+test_that("Replacement system.file returns correct values when installed", {
+  # This set of tests is mostly a sanity check - it doesn't use the special
+  # version of system.file, but it's useful to make sure we know what to look
+  # for in the other tests.
+
+  # Make a temp lib directory to install test package into
+  old_libpaths <- .libPaths()
+  tmp_libpath = file.path(tempdir(), "devtools_test")
+  if (!dir.exists(tmp_libpath)) dir.create(tmp_libpath)
+  .libPaths(c(tmp_libpath, .libPaths()))
+
+  install("shim")
+  expect_true(require(shim))
+
+  # The special version of system.file shouldn't exist - this get() will fall
+  # through to the base namespace
+  expect_identical(get("system.file", pos = asNamespace("shim")),
+    base::system.file)
+
+  # Test within package shim
+  files <- sysfile_wrap(c("A.txt", "B.txt", "C.txt", "D.txt"),
+    package = "shim")
+  files <- expand_path(files)
+  expect_true(all(last_n(files[[1]], 2) == c("shim", "A.txt")))
+  expect_true(all(last_n(files[[2]], 2) == c("shim", "B.txt")))
+  expect_equal(length(files), 2)  # Third and fourth should be dropped
+
+  # If all files are not present, return ""
+  files <- sysfile_wrap("nonexistent", package = "shim")
+  expect_equal(files, "")
+
+  detach("package:shim", unload = TRUE)
+
+  # Reset the libpath
+  .libPaths(old_libpaths)
+})

man/load_all.Rd

@@ -41,7 +41,8 @@
   a child of the imports environment, which has the name
   attribute \code{imports:pkgname}. It is in turn is a
   child of \code{<namespace:base>}, which is a child of the
-  global environment.
+  global environment. (There is also a copy of the base
+  namespace that is a child of the empty environment.)
 
   The package environment \code{<package:pkgname>} is an
   ancestor of the global environment. Normally when loading
@@ -57,6 +58,15 @@
   behavior when loading an installed package with
   \code{\link{library}}, and can be useful for checking for
   missing exports.
+
+  \code{load_all} also inserts shim functions into the
+  imports environment of the laded package. It presently
+  adds a replacement version of \code{system.file} which
+  returns different paths from \code{base::system.file}.
+  This is needed because installed and uninstalled package
+  sources have different directory structures. Note that
+  this is not a perfect replacement for
+  \code{base::system.file}.
 }
 \examples{
 \dontrun{