Permalink
Browse files

Merge pull request #213 from wch/shim

Replacement for system.file. Fixes #179
  • Loading branch information...
wch committed Dec 14, 2012
2 parents fa70de6 + 69bb404 commit be1017c35620c3d7baca84826746adaf414daedb
View
@@ -83,3 +83,4 @@ Collate:
'rcpp-attributes.r'
'cran.r'
'load-depends.r'
+ 'shims.r'
View
6 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.
View
@@ -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)
View
@@ -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.
+ }
+ }
+}
View
@@ -0,0 +1 @@
+file /A.txt
View
@@ -0,0 +1 @@
+file /C.txt
@@ -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
@@ -0,0 +1 @@
+export(sysfile_wrap)
View
@@ -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(...)
+}
@@ -0,0 +1 @@
+file inst/A.txt
@@ -0,0 +1 @@
+file inst/B.txt
View
@@ -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)
+})
View
@@ -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{

0 comments on commit be1017c

Please sign in to comment.