Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Stop on errors in examples

  • Loading branch information...
commit 8556d438945e0f435c59d15090dc592db614cef1 1 parent d5d1c76
Hadley Wickham authored

Showing 2 changed files with 41 additions and 2 deletions. Show diff stats Hide diff stats

  1. 5  NAMESPACE
  2. 38  R/run-example.r
5  NAMESPACE
... ...
@@ -1,5 +1,7 @@
1 1
 S3method("[",envlist)
2  
-S3method(print,envlist)
  2
+S3method(replay_stop,default)
  3
+S3method(replay_stop,error)
  4
+S3method(replay_stop,list)
3 5
 export(add_path)
4 6
 export(as.envlist)
5 7
 export(as.package)
@@ -44,6 +46,7 @@ export(on_path)
44 46
 export(parent_envs)
45 47
 export(parse_ns_file)
46 48
 export(pkg_env)
  49
+export(print.envlist)
47 50
 export(release)
48 51
 export(reload)
49 52
 export(revdep)
38  R/run-example.r
@@ -11,7 +11,7 @@ run_example <- function(path, show = TRUE, test = FALSE, run = TRUE, env = new.e
11 11
 
12 12
   code <- paste(code, collapse = "")
13 13
   results <- evaluate(code, env)
14  
-  replay(results)
  14
+  replay_stop(results)
15 15
 }
16 16
 
17 17
 process_ex <- function(rd, show = TRUE, test = FALSE, run = TRUE) {
@@ -69,3 +69,39 @@ remove_tag <- function(x) {
69 69
   attr(x, "Rd_tag") <- NULL
70 70
   x
71 71
 }
  72
+
  73
+replay.error <- function(x) {
  74
+  if (is.null(x$call)) {
  75
+    message("Error: ", x$message)    
  76
+  } else {
  77
+    call <- deparse(x$call)
  78
+    message("Error in ", call, ": ", x$message)    
  79
+  }
  80
+}
  81
+
  82
+
  83
+replay_stop <- function(x) UseMethod("replay_stop", x)
  84
+#' @S3method replay_stop error
  85
+replay_stop.error <- function(x) {
  86
+  stop(quiet_error(x$message, x$call))
  87
+}
  88
+#' @S3method replay_stop default
  89
+replay_stop.default <- function(x) replay(x)
  90
+
  91
+#' @S3method replay_stop list
  92
+replay_stop.list <- function(x) {
  93
+  invisible(lapply(x, replay_stop))
  94
+}
  95
+
  96
+quiet_error <- function(message, call = NULL) {
  97
+  structure(list(message = as.character(message), call = call), 
  98
+    class = c("quietError", "error", "condition"))
  99
+}
  100
+as.character.quietError <- function(x) {
  101
+  if (is.null(x$call)) {
  102
+    paste("Error: ", x$message, sep = "")
  103
+  } else {
  104
+    call <- deparse(x$call)
  105
+    paste("Error in ", call, ": ", x$message, sep = "")
  106
+  }
  107
+}

0 notes on commit 8556d43

Please sign in to comment.
Something went wrong with that request. Please try again.