Always needs to capture output before handling conditions (#139)

Fixes #28

NEWS.md

@@ -1,5 +1,7 @@
 # evaluate (development version)
 
+* `evaluate()` now correctly captures plots created before messages/warnings/errors (#28).
+
 # evaluate 0.24.0
 
 * The `source` output handler can now take two arguments (the unparsed `src` 

R/eval.R

@@ -155,7 +155,7 @@ evaluate_top_level_expression <- function(exprs,
   output <- list(source)
 
   dev <- dev.cur()
-  handle_output <- function(plot = FALSE, incomplete_plots = FALSE) {
+  handle_output <- function(plot = TRUE, incomplete_plots = FALSE) {
     # if dev.cur() has changed, we should not record plots any more
     plot <- plot && identical(dev, dev.cur())
     out <- w$get_new(plot, incomplete_plots,
@@ -166,22 +166,14 @@ evaluate_top_level_expression <- function(exprs,
   local_output_handler(function() handle_output(FALSE))
 
   # Hooks to capture plot creation
-  capture_plot <- function() {
-    handle_output(TRUE)
-  }
   hook_list <- list(
-    persp = capture_plot,
-    before.plot.new = capture_plot,
-    before.grid.newpage = capture_plot
+    persp = handle_output,
+    before.plot.new = handle_output,
+    before.grid.newpage = handle_output
   )
   set_hooks(hook_list)
   on.exit(remove_hooks(hook_list), add = TRUE)
 
-  handle_condition <- function(cond) {
-    handle_output()
-    output <<- c(output, list(cond))
-  }
-
   # Handlers for warnings, errors and messages
   wHandler <- function(wn) {
     if (log_warning) {
@@ -193,21 +185,28 @@ evaluate_top_level_expression <- function(exprs,
     if (getOption("warn") >= 2) return()
 
     if (keep_warning && getOption("warn") >= 0) {
-      handle_condition(wn)
+      handle_output()
+      output <<- c(output, list(wn))
       output_handler$warning(wn)
     }
     invokeRestart("muffleWarning")
   }
-  eHandler <- if (use_try) function(e) {
-    handle_condition(e)
-    output_handler$error(e)
-  } else identity
-  mHandler <- if (is.na(keep_message)) identity else function(m) {
-    if (keep_message) {
-      handle_condition(m)
+  eHandler <- function(e) {
+    handle_output()
+    if (use_try) {
+      output <<- c(output, list(e))
+      output_handler$error(e)
+    }
+  }
+  mHandler <- function(m) {
+    handle_output()
+    if (isTRUE(keep_message)) {
+      output <<- c(output, list(m))
       output_handler$message(m)
+      invokeRestart("muffleMessage")
+    } else if (isFALSE(keep_message)) {
+      invokeRestart("muffleMessage")
     }
-    invokeRestart("muffleMessage")
   }
 
   ev <- list(value = NULL, visible = FALSE)

tests/testthat/test-eval.R

@@ -1,3 +1,62 @@
+test_that("all condition handlers first capture output", {
+  test <- function(){
+    plot(1, main = "one")
+    message("this is an message!")
+    plot(2, main = "two")
+    warning("this is a warning")
+    plot(3, main = "three")
+    stop("this is an error")
+  }
+  expect_equal(
+    classes(evaluate("test()")),
+    c(
+      "source",
+      "recordedplot",
+      "simpleMessage",
+      "recordedplot",
+      "simpleWarning",
+      "recordedplot",
+      "simpleError"
+    )
+  )
+})
+
+test_that("all three states of keep_warning work as expected", {
+  test <- function() {
+    warning("Hi!")
+  }
+
+  # warning captured in output
+  expect_no_warning(ev <- evaluate("test()", keep_warning = TRUE))
+  expect_equal(classes(ev), c("source", "simpleWarning"))
+
+  # warning propagated
+  expect_warning(ev <- evaluate("test()", keep_warning = NA), "Hi")
+  expect_equal(classes(ev), "source")
+
+  # warning ignored
+  expect_no_warning(ev <- evaluate("test()", keep_warning = FALSE))
+  expect_equal(classes(ev), "source")
+})
+
+test_that("all three states of keep_message work as expected", {
+  test <- function() {
+    message("Hi!")
+  }
+
+  # message captured in output
+  expect_no_message(ev <- evaluate("test()", keep_message = TRUE))
+  expect_equal(classes(ev), c("source", "simpleMessage"))
+
+  # message propagated
+  expect_message(ev <- evaluate("test()", keep_message = NA), "Hi")
+  expect_equal(classes(ev), "source")
+
+  # message ignored
+  expect_no_message(ev <- evaluate("test()", keep_message = FALSE))
+  expect_equal(classes(ev), "source")
+})
+
 test_that("can evaluate expressions of all lengths", {
   source <- "
     # a comment