From 4abed656f17f91f1acc64c45a4ad41ffcdab62ba Mon Sep 17 00:00:00 2001 From: hadley Date: Tue, 12 Jan 2016 15:37:17 -0600 Subject: [PATCH] Add package_file. Fixes #985. --- NAMESPACE | 1 + NEWS.md | 4 +++ R/package.r | 69 +++++++++++++++++++------------------- man/package_file.Rd | 25 ++++++++++++++ tests/testthat/test-load.r | 8 ++--- 5 files changed, 68 insertions(+), 39 deletions(-) create mode 100644 man/package_file.Rd diff --git a/NAMESPACE b/NAMESPACE index 692d96776..58c7098c3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -92,6 +92,7 @@ export(missing_s3) export(ns_env) export(on_path) export(package_deps) +export(package_file) export(parse_deps) export(parse_ns_file) export(pkg_env) diff --git a/NEWS.md b/NEWS.md index 4db3d8301..f6b2a25b2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # devtools 1.9.1.9000 +* `package_file()` lets you find files inside a package. It always first locates + the root directory of the package (i.e. the directory that contains + `DESCRIPTION`) (#985). + * `check(cran = TRUE)` also adds `--run-donttest` since you do need to test code in `\dontest()` for CRAN submission (#1002). diff --git a/R/package.r b/R/package.r index 65221c849..4a8e42dd8 100644 --- a/R/package.r +++ b/R/package.r @@ -14,64 +14,63 @@ as.package <- function(x = NULL, create = NA) { if (is.package(x)) return(x) - x <- check_dir(x) + x <- package_file(path = x) load_pkg_description(x, create = create) } - -check_dir <- function(x) { - if (is.null(x)) { - stop("Path is null", call. = FALSE) +#' Find file in a package. +#' +#' It always starts by finding by walking up the path until it finds the +#' root directory, i.e. a directory containing \code{DESCRIPTION}. If it +#' cannot find the root directory, or it can't find the specified path, it +#' will throw an error. +#' +#' @param ... Components of the path. +#' @param path Place to start search for package directory. +#' @export +#' @examples +#' \dontrun{ +#' package_file("figures", "figure_1") +#' } +package_file <- function(..., path = ".") { + if (!is.character(path) || length(path) != 1) { + stop("`path` must be a string.", call. = FALSE) } - - # Normalise path and strip trailing slashes - x <- normalise_path(x) - x <- package_root(x) %||% x - - if (!file.exists(x)) { - stop("Can't find directory ", x, call. = FALSE) + if (!file.exists(path)) { + stop("Can't find '", path, "'.", call. = FALSE) } - if (!file.info(x)$isdir) { - stop(x, " is not a directory", call. = FALSE) + if (!file.info(path)$isdir) { + stop("'", path, "' is not a directory.", call. = FALSE) } - x -} + # Walk up to root directory + path <- strip_slashes(normalizePath(path)) + while (!has_description(path)) { + path <- dirname(path) -package_root <- function(path) { - if (is.package(path)) { - return(path$path) + if (is_root(path)) { + stop("Could not find package root.", call. = FALSE) + } } - stopifnot(is.character(path)) - has_description <- function(path) { - file.exists(file.path(path, 'DESCRIPTION')) - } - path <- normalizePath(path, mustWork = FALSE) - while (!has_description(path) && !is_root(path)) { - path <- dirname(path) - } + file.path(path, ...) +} - if (is_root(path)) { - NULL - } else { - path - } +has_description <- function(path) { + file.exists(file.path(path, 'DESCRIPTION')) } is_root <- function(path) { identical(path, dirname(path)) } -normalise_path <- function(x) { - x <- sub("\\\\+$", "/", x) +strip_slashes <- function(x) { x <- sub("/*$", "", x) x } # Load package DESCRIPTION into convenient form. load_pkg_description <- function(path, create) { - path <- normalizePath(path) path_desc <- file.path(path, "DESCRIPTION") if (!file.exists(path_desc)) { diff --git a/man/package_file.Rd b/man/package_file.Rd new file mode 100644 index 000000000..badd3276f --- /dev/null +++ b/man/package_file.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/package.r +\name{package_file} +\alias{package_file} +\title{Find file in a package.} +\usage{ +package_file(..., path = ".") +} +\arguments{ +\item{...}{Components of the path.} + +\item{path}{Place to start search for package directory.} +} +\description{ +It always starts by finding by walking up the path until it finds the +root directory, i.e. a directory containing \code{DESCRIPTION}. If it +cannot find the root directory, or it can't find the specified path, it +will throw an error. +} +\examples{ +\dontrun{ +package_file("figures", "figure_1") +} +} + diff --git a/tests/testthat/test-load.r b/tests/testthat/test-load.r index baf8dd58d..574cdf693 100644 --- a/tests/testthat/test-load.r +++ b/tests/testthat/test-load.r @@ -10,7 +10,7 @@ test_that("user is queried if no package structure present", { `devtools::interactive` = function() TRUE, `utils::menu` = function(...) stop("menu() called"), `devtools::setup` = function(...) stop("setup() called"), - `devtools::check_dir` = function(x) x, + `devtools::package_file` = function(..., path) file.path(path, ...), expect_error(load_all(file.path("testLoadDir", "R")), "menu[(][)] called") ) @@ -21,7 +21,7 @@ test_that("setup is called upon user consent if no package structure present", { `devtools::interactive` = function() TRUE, `utils::menu` = function(choices, ...) match("Yes", choices), `devtools::setup` = function(...) stop("setup() called"), - `devtools::check_dir` = function(x) x, + `devtools::package_file` = function(..., path) file.path(path, ...), expect_error(load_all(file.path("testLoadDir", "R")), "setup[(][)] called") ) @@ -31,7 +31,7 @@ test_that("setup is called if no package structure present", { with_mock( `utils::menu` = function(...) stop("menu() called"), `devtools::setup` = function(...) stop("setup() called"), - `devtools::check_dir` = function(x) x, + `devtools::package_file` = function(..., path) file.path(path, ...), expect_error(load_all(file.path("testLoadDir", "R"), create = TRUE), "setup[(][)] called") ) @@ -41,7 +41,7 @@ test_that("error is thrown if no package structure present", { with_mock( `utils::menu` = function(...) stop("menu() called"), `devtools::setup` = function(...) stop("setup() called"), - `devtools::check_dir` = function(x) x, + `devtools::package_file` = function(..., path) file.path(path, ...), expect_error(load_all(file.path("testLoadDir", "R"), create = FALSE), "No description at") )