Permalink
Browse files

Stop on errors in examples

  • Loading branch information...
1 parent d5d1c76 commit 8556d438945e0f435c59d15090dc592db614cef1 @hadley committed Aug 22, 2012
Showing with 41 additions and 2 deletions.
  1. +4 −1 NAMESPACE
  2. +37 −1 R/run-example.r
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)
View
@@ -11,7 +11,7 @@ run_example <- function(path, show = TRUE, test = FALSE, run = TRUE, env = new.e
code <- paste(code, collapse = "")
results <- evaluate(code, env)
- replay(results)
+ replay_stop(results)
}
process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
@@ -69,3 +69,39 @@ 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 = "")
+ }
+}

0 comments on commit 8556d43

Please sign in to comment.