From 43a5b9255ce18b3507013f1b19f97956549bf9f9 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Mon, 17 Jun 2024 10:16:19 +0100
Subject: [PATCH] Always needs to capture output before handling conditions

Fixes #28
---
 NEWS.md                    |  2 ++
 R/eval.R                   | 41 +++++++++++++-------------
 tests/testthat/test-eval.R | 59 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 81 insertions(+), 21 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index c1fbf046..f7b4415e 100644
--- a/NEWS.md
+++ b/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` 
diff --git a/R/eval.R b/R/eval.R
index 8d2b84f7..262e0af0 100644
--- a/R/eval.R
+++ b/R/eval.R
@@ -166,7 +166,7 @@ evaluate_call <- function(call,
   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,
@@ -180,22 +180,14 @@ evaluate_call <- function(call,
   .env$flush_console <- 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) {
@@ -207,21 +199,28 @@ evaluate_call <- function(call,
     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)
diff --git a/tests/testthat/test-eval.R b/tests/testthat/test-eval.R
index ee7bef8f..7e88b633 100644
--- a/tests/testthat/test-eval.R
+++ b/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("log_echo causes output to be immediately written to stderr()", {
   f <- function() {
     1