Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Replace tools:::Rd2ex with custom code.

Fixes #118.  Closes #144
  • Loading branch information...
commit 3afa697a9648d5ad9bafc835afa57961fca7f8f6 1 parent d2477f3
Hadley Wickham authored
11 DESCRIPTION
View
@@ -1,8 +1,8 @@
Package: devtools
Title: Tools to make developing R code easier
Version: 0.7.1
-Author: Hadley Wickham <h.wickham@gmail.com>,
- Winston Chang <winston@stdout.org>
+Author: Hadley Wickham <h.wickham@gmail.com>,
+ Winston Chang <winston@stdout.org>
Maintainer: Hadley Wickham <h.wickham@gmail.com>
Description: Collection of package development tools
Depends:
@@ -13,7 +13,8 @@ Imports:
utils,
tools,
memoise,
- whisker
+ whisker,
+ evaluate
Suggests:
testthat,
roxygen2,
@@ -71,4 +72,6 @@ Collate:
'imports-env.r'
'namespace-env.r'
'topic-index.r'
- 'help.r'
+ 'dev-example.r'
+ 'run-example.r'
+ 'dev-help.r'
7 NAMESPACE
View
@@ -1,5 +1,7 @@
S3method("[",envlist)
-S3method(print,envlist)
+S3method(replay_stop,default)
+S3method(replay_stop,error)
+S3method(replay_stop,list)
export(add_path)
export(as.envlist)
export(as.package)
@@ -44,6 +46,7 @@ export(on_path)
export(parent_envs)
export(parse_ns_file)
export(pkg_env)
+export(print.envlist)
export(release)
export(reload)
export(revdep)
@@ -67,6 +70,8 @@ export(with_options)
export(with_par)
export(with_path)
importFrom(RCurl,ftpUpload)
+importFrom(evaluate,evaluate)
+importFrom(evaluate,replay)
importFrom(httr,GET)
importFrom(httr,authenticate)
importFrom(httr,config)
5 R/dependencies.r
View
@@ -41,8 +41,9 @@ cran_packages <- memoise(function() {
#' @importFrom memoise memoise
bioc_packages <- memoise(function() {
- on.exit(closeAllConnections())
- bioc <- read.dcf(url("http://bioconductor.org/packages/release/bioc/VIEWS"))
+ con <- url("http://bioconductor.org/packages/release/bioc/VIEWS")
+ on.exit(close(con))
+ bioc <- read.dcf(con)
rownames(bioc) <- bioc[, 1]
bioc
})
28 R/dev-example.r
View
@@ -0,0 +1,28 @@
+#' Run a examples for an in-development function.
+#'
+#' @inheritParams run_examples
+#' @param topic Name or topic (or name of Rd) file to run examples for
+#' @export
+#' @family example functions
+#' @examples
+#' \dontrun{
+#' # Runs installed example:
+#' library("ggplot2")
+#' example("ggplot")
+#'
+#' # Runs develoment example:
+#' load_all("ggplot2")
+#' dev_example("ggplot")
+#' }
+dev_example <- function(topic) {
+ path <- find_topic(topic)
+
+ if (is.null(path)) {
+ stop("Can't find development example for topic ", topic, call. = FALSE)
+ }
+
+ pkg <- as.package(names(path)[[1]])
+ load_all(pkg)
+
+ run_example(path)
+}
0  R/help.r → R/dev-help.r
View
File renamed without changes
22 R/document.r
View
@@ -7,9 +7,12 @@
#' freshest version of the documentation.
#' check documentation after running roxygen.
#' @param roclets character vector of roclet names to apply to package
+#' @param reload if \code{TRUE} uses \code{load_all} to reload the package
+#' prior to documenting. This is important because \pkg{roxygen2} uses
+#' introspection on the code objects to determine how to document them.
#' @keywords programming
#' @export
-document <- function(pkg = NULL, clean = FALSE, roclets = c("collate", "namespace", "rd")) {
+document <- function(pkg = NULL, clean = FALSE, roclets = c("collate", "namespace", "rd"), reload = TRUE) {
require("roxygen2")
pkg <- as.package(pkg)
message("Updating ", pkg$package, " documentation")
@@ -21,18 +24,25 @@ document <- function(pkg = NULL, clean = FALSE, roclets = c("collate", "namespac
roxygen2:::clear_caches()
file.remove(dir(man_path, full.names = TRUE))
}
- loaded <- load_all(pkg, reset = clean)
+
+ if (reload) {
+ load_all(pkg, reset = clean)
+ }
# Integrate source and evaluated code
- env_hash <- suppressWarnings(digest(loaded$env))
- parsed <- unlist(lapply(loaded$code, parse.file, env = loaded$env,
+ env <- ns_env(pkg)
+ env_hash <- suppressWarnings(digest(env))
+ r_files <- find_code(pkg)
+ parsed <- unlist(lapply(r_files, parse.file, env = env,
env_hash = env_hash), recursive = FALSE)
roclets <- paste(roclets, "_roclet", sep = "")
for (roclet in roclets) {
roc <- match.fun(roclet)()
- results <- with_collate("C", roxygen2:::roc_process(roc, parsed, pkg$path))
- roxygen2:::roc_output(roc, results, pkg$path)
+ with_collate("C", {
+ results <- roxygen2:::roc_process(roc, parsed, pkg$path)
+ roxygen2:::roc_output(roc, results, pkg$path)
+ })
}
clear_topic_index(pkg)
2  R/install-github.r
View
@@ -43,7 +43,7 @@ install_github <- function(repo, username = getOption("github.user"),
if (!is.null(password)) {
auth <- authenticate(
- user = if (is.null(auth_user)) username else auth_user,
+ user = auth_user %||% username,
password = password,
type = "basic")
} else {
107 R/run-example.r
View
@@ -0,0 +1,107 @@
+#' @importFrom evaluate evaluate replay
+#' @importFrom tools parse_Rd
+run_example <- function(path, show = TRUE, test = FALSE, run = TRUE, env = new.env(parent = globalenv())) {
+ rd <- parse_Rd(path)
+ ex <- rd[rd_tags(rd) == "examples"]
+ code <- process_ex(ex, show = show, test = test, run = run)
+ if (is.null(code)) return()
+
+ message("Running examples in ", basename(path))
+ rule()
+
+ code <- paste(code, collapse = "")
+ results <- evaluate(code, env)
+ replay_stop(results)
+}
+
+process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
+ tag <- rd_tag(rd)
+
+ recurse <- function(rd) {
+ unlist(lapply(rd, process_ex, show = show, test = test, run = run))
+ }
+
+ if (is.null(tag) || tag == "examples") {
+ return(recurse(rd))
+ }
+
+ # Base case
+ if (tag %in% c("RCODE", "COMMENT", "TEXT", "VERB")) {
+ return(rd[[1]])
+ }
+
+ # Conditional execution
+ if (tag %in% c("dontshow", "dontrun", "donttest", "testonly")) {
+ out <- recurse(rd)
+
+ if ((tag == "dontshow" && show) ||
+ (tag == "dontrun" && run) ||
+ (tag == "donttest" && test) ||
+ (tag == "testonly" && !test)) {
+ type <- paste("\n# ", toupper(tag), "\n", sep = "")
+ out <- c(type, out)
+ out <- gsub("\n", "\n# ", out)
+ }
+ return(out)
+ }
+
+ if (tag %in% c("dots", "ldots")) {
+ return("...")
+ }
+
+ warning("Unknown tag ", tag, call. = FALSE)
+ tag
+}
+
+
+rd_tag <- function(x) {
+ tag <- attr(x, "Rd_tag")
+ if (is.null(tag)) return()
+
+ gsub("\\", "", tag, fixed = TRUE)
+}
+
+rd_tags <- function(x) {
+ vapply(x, function(x) rd_tag(x) %||% "", character(1))
+}
+
+remove_tag <- function(x) {
+ attr(x, "Rd_tag") <- NULL
+ x
+}
+
+replay.error <- function(x) {
+ if (is.null(x$call)) {
+ message("Error: ", x$message)
+ } else {
+ call <- deparse(x$call)
+ message("Error in ", call, ": ", x$message)
+ }
+}
+
+
+replay_stop <- function(x) UseMethod("replay_stop", x)
+#' @S3method replay_stop error
+replay_stop.error <- function(x) {
+ stop(quiet_error(x$message, x$call))
+}
+#' @S3method replay_stop default
+replay_stop.default <- function(x) replay(x)
+
+#' @S3method replay_stop list
+replay_stop.list <- function(x) {
+ invisible(lapply(x, replay_stop))
+}
+
+quiet_error <- function(message, call = NULL) {
+ structure(list(message = as.character(message), call = call),
+ class = c("quietError", "error", "condition"))
+}
+as.character.quietError <- function(x) {
+ if (is.null(x$call)) {
+ paste("Error: ", x$message, sep = "")
+ } else {
+ call <- deparse(x$call)
+ paste("Error in ", call, ": ", x$message, sep = "")
+ }
+}
105 R/run-examples.r
View
@@ -7,102 +7,49 @@
#'
#' @param pkg package description, can be path or package name. See
#' \code{\link{as.package}} for more information
-#' @param start name of \code{Rd} file to start with - if omitted, will start
-#' with the (lexicographically) first file. This is useful if you have a
-#' lot of examples and don't want to rerun them every time when you fix a
-#' problem.
-#' @param strict if \code{TRUE}, the package is first installed, and then each
-#' example is run in a clean R environment somewhat mimicking what
-#' \code{R CMD check} does. Since this involves installing the package
-#' you should probably be in \code{\link{dev_mode}}
+#' @param start Where to start running the examples: this can either be the
+#' name of \code{Rd} file to start with (with or without extensions), or
+#' a topic name. If omitted, will start with the (lexicographically) first
+#' file. This is useful if you have a lot of examples and don't want to
+#' rerun them every time when you fix a problem.
#' @family example functions
+#' @param show if \code{TRUE}, code in \code{\\dontshow{}} will be commented
+#' out
+#' @param test if \code{TRUE}, code in \code{\\donttest{}} will be commented
+#' out. If \code{FALSE}, code in \code{\\testonly{}} will be commented out.
+#' @param run if \code{TRUE}, code in \code{\\dontrun{}} will be commented
+#' out.
#' @keywords programming
#' @export
-run_examples <- function(pkg = NULL, start = NULL, strict = TRUE) {
+run_examples <- function(pkg = NULL, start = NULL, show = TRUE, test = FALSE, run = TRUE) {
pkg <- as.package(pkg)
- document(pkg)
+ load_all(pkg, reset = TRUE, export_all = FALSE)
+ on.exit(load_all(pkg, reset = TRUE))
+ document(pkg, reload = FALSE)
path_man <- file.path(pkg$path, "man")
files <- dir(path_man, pattern = "\\.[Rr]d$", full.names = TRUE)
names(files) <- basename(files)
- files <- sort(files)
+ files <- with_collate("C", sort(files))
if (!is.null(start)) {
- start_pos <- which(names(files) == start)
+ start_path <- find_pkg_topic(pkg, start)
+ if (is.null(start_path)) {
+ stop("Couldn't find start position ", start, call. = FALSE)
+ }
+
+ start_pos <- which(names(files) == start_path)
if (length(start_pos) == 1) {
files <- files[- seq(1, start_pos - 1)]
}
}
- suppressWarnings(rd <- lapply(files, tools::parse_Rd))
- has_examples <- function(rd) {
- tags <- tools:::RdTags(rd)
- any(tags == "\\examples")
- }
- rd <- Filter(has_examples, rd)
-
- if (strict) install(pkg)
-
- message("Running ", length(rd), " examples in ", pkg$package)
- message(paste(rep("-", getOption("width"), collapse = "")))
- mapply(run_one_example, names(rd), rd,
- MoreArgs = list(env = parent.frame(), strict = strict, pkg = pkg))
- invisible()
-}
-
-run_one_example <- function(name, rd, pkg, env = parent.frame(), strict = TRUE) {
- message("Checking ", name, "...")
- message(paste(rep("-", getOption("width"), collapse = "")))
-
- # Need to write out to temporary file to circumvent bug in source + echo = T
- tmp <- tempfile()
- on.exit(unlink(tmp))
-
- # Use internal Rd2ex code which strips out \dontrun etc - if there is
- # no example it doesn't create the file
- tools:::Rd2ex(rd, tmp)
- if (!file.exists(tmp)) return(invisible(NULL))
-
- if (strict) {
- ex <- c(paste("library('", pkg$package, "')", sep = ""), readLines(tmp))
- writeLines(ex, tmp)
- clean_source(tmp)
- } else {
- source(tmp, echo = TRUE, keep.source = TRUE, max.deparse.length = Inf,
- skip.echo = 6)
- }
- cat("\n\n")
-}
-
-#' Run a examples for an in-development function.
-#'
-#' @inheritParams run_examples
-#' @param topic Name or topic (or name of Rd) file to run examples for
-#' @export
-#' @family example functions
-#' @examples
-#' \dontrun{
-#' # Runs installed example:
-#' library("ggplot2")
-#' example("ggplot")
-#'
-#' # Runs develoment example:
-#' load_all("ggplot2")
-#' dev_example("ggplot")
-#' }
-dev_example <- function(topic, strict = FALSE) {
- path <- find_topic(topic)
-
- if (is.null(path)) {
- stop("Can't find development example for topic ", topic, call. = FALSE)
- }
-
- pkg <- as.package(names(path)[[1]])
- load_all(pkg)
+ message("Running ", length(files), " example files in ", pkg$package)
+ rule()
+ lapply(files, run_example, show = show, test = test, run = run)
- run_one_example(topic, path, pkg, strict = strict)
+ invisible()
}
-
# If an error occurs, should print out the suspect line of code, and offer
# the following options:
# * skip to the next example
2  R/topic-index.r
View
@@ -15,7 +15,7 @@ find_pkg_topic <- function(pkg, topic) {
# Finally, try adding .Rd to name
man_rd <- file.path(pkg$path, "man", paste(topic, ".Rd"))
- if (file.exists(man)) return(basename(man))
+ if (file.exists(man_rd)) return(basename(man_rd))
NULL
}
8 R/utils.r
View
@@ -4,3 +4,11 @@ dir.exists <- function(x) {
res <- file.exists(x) & file.info(x)$isdir
setNames(res, x)
}
+
+
+"%||%" <- function(a, b) if (!is.null(a)) a else b
+
+rule <- function() {
+ message(paste(rep("-", getOption("width"), collapse = "")))
+}
+
8 man/dev_example.Rd
View
@@ -2,17 +2,11 @@
\alias{dev_example}
\title{Run a examples for an in-development function.}
\usage{
- dev_example(topic, strict = FALSE)
+ dev_example(topic)
}
\arguments{
\item{topic}{Name or topic (or name of Rd) file to run
examples for}
-
- \item{strict}{if \code{TRUE}, the package is first
- installed, and then each example is run in a clean R
- environment somewhat mimicking what \code{R CMD check}
- does. Since this involves installing the package you
- should probably be in \code{\link{dev_mode}}}
}
\description{
Run a examples for an in-development function.
8 man/document.Rd
View
@@ -3,7 +3,8 @@
\title{Use roxygen to make documentation.}
\usage{
document(pkg = NULL, clean = FALSE,
- roclets = c("collate", "namespace", "rd"))
+ roclets = c("collate", "namespace", "rd"),
+ reload = TRUE)
}
\arguments{
\item{pkg}{package description, can be path or package
@@ -17,6 +18,11 @@
\item{roclets}{character vector of roclet names to apply
to package}
+
+ \item{reload}{if \code{TRUE} uses \code{load_all} to
+ reload the package prior to documenting. This is
+ important because \pkg{roxygen2} uses introspection on
+ the code objects to determine how to document them.}
}
\description{
Use roxygen to make documentation.
23 man/run_examples.Rd
View
@@ -2,23 +2,30 @@
\alias{run_examples}
\title{Run all examples in a package.}
\usage{
- run_examples(pkg = NULL, start = NULL, strict = TRUE)
+ run_examples(pkg = NULL, start = NULL, show = TRUE,
+ test = FALSE, run = TRUE)
}
\arguments{
\item{pkg}{package description, can be path or package
name. See \code{\link{as.package}} for more information}
- \item{start}{name of \code{Rd} file to start with - if
+ \item{start}{Where to start running the examples: this
+ can either be the name of \code{Rd} file to start with
+ (with or without extensions), or a topic name. If
omitted, will start with the (lexicographically) first
- file. This is useful if you have a lot of examples and
+ file. This is useful if you have a lot of examples and
don't want to rerun them every time when you fix a
problem.}
- \item{strict}{if \code{TRUE}, the package is first
- installed, and then each example is run in a clean R
- environment somewhat mimicking what \code{R CMD check}
- does. Since this involves installing the package you
- should probably be in \code{\link{dev_mode}}}
+ \item{show}{if \code{TRUE}, code in \code{\\dontshow{}}
+ will be commented out}
+
+ \item{test}{if \code{TRUE}, code in \code{\\donttest{}}
+ will be commented out. If \code{FALSE}, code in
+ \code{\\testonly{}} will be commented out.}
+
+ \item{run}{if \code{TRUE}, code in \code{\\dontrun{}}
+ will be commented out.}
}
\description{
One of the most frustrating parts of `R CMD check` is
Please sign in to comment.
Something went wrong with that request. Please try again.