The value returned by print should be ignored

NEWS.md

@@ -1,5 +1,6 @@
 # evaluate (development version)
 
+* `evaluate()` no longer incorrectly prints the return value of print methods.
 * `evaluate()` automatically strips calls from conditions emitted by top-level code (these incorrectly get calls because they're wrapped inside `eval()`) (#150).
 * `evalute(include_timing)` has been deprecated. I can't find any use of it on GitHub, and it adds substantial code complexity for little gain.
 * `watchout()` is no longer exported; it's really an implementation detail that should never have been leaked to the public interface.

R/eval.R

@@ -187,14 +187,12 @@ evaluate_top_level_expression <- function(exprs,
     }
   }
 
-  if (use_try) {
-    handle <- function(code) {
-      tryCatch(code, error = function(err) {
-        list(value = NULL, visible = FALSE)
-      })
+  handle_error <- function(code) {
+    if (use_try) {
+      tryCatch(code, error = function(err) NULL)
+    } else {
+      code
     }
-  } else {
-    handle <- force
   }
 
   user_handlers <- output_handler$calling_handlers
@@ -203,30 +201,27 @@ evaluate_top_level_expression <- function(exprs,
   handlers <- c(user_handlers, evaluate_handlers)
 
   for (expr in exprs) {
-    ev <- handle(
+    ev <- handle_error(
       with_handlers(
         withVisible(eval(expr, envir)),
         handlers
       )
     )
+
     handle_output(TRUE)
 
-    if (show_value(output_handler, ev$visible)) {
+    if (!is.null(ev) && show_value(output_handler, ev$visible)) {
       # Ideally we'd evaluate the print() generic in envir in order to find
       # any methods registered in that environment. That, however, is 
       # challenging and only makes a few tests a little simpler so we don't
       # bother.
-      pv <- handle(
+      handle_error(
         with_handlers(
-          withVisible(
-            handle_value(output_handler, ev$value, ev$visible)
-          ),
+          handle_value(output_handler, ev$value, ev$visible),
           handlers
         )
       )
       handle_output(TRUE)
-      # If the return value is visible, save the value to the output
-      if (pv$visible) output <- c(output, list(pv$value))
     }
   }
   # Always capture last plot, even if incomplete

R/output.R

@@ -97,6 +97,9 @@ render <- function(x) if (isS4(x)) methods::show(x) else print(x)
 #'   * If it has one argument, it called on visible values.
 #'   * If it has two arguments, it handles all values, with the second
 #'     argument indicating whether or not the value is visible.
+#' 
+#'   The return value of the handler is ignored; its job is to print
+#'   output to the screen.
 #' @param calling_handlers List of [calling handlers][withCallingHandlers].
 #'   These handlers have precedence over the exiting handler installed
 #'   by [evaluate()] when `stop_on_error` is set to 0.

tests/testthat/_snaps/replay.md

@@ -1,11 +1,3 @@
-# replay() should work when print() returns visible NULLs
-
-    Code
-      replay(ret)
-    Output
-      > structure(1, class = "FOO_BAR")
-      NULL
-
 # format_condition handles different types of warning
 
     Code

tests/testthat/test-eval.R

@@ -120,6 +120,15 @@ test_that("source handled called correctly when src is unparseable", {
   expect_equal(call, expression())
 })
 
+test_that("visible print() values are not printed", {
+  # need to put S3 method in global namespace otherwise it isn't found
+  assign("print.FOO_BAR", function(x, ...) NULL, envir = globalenv())
+  defer(rm(print.FOO_BAR, envir = globalenv()))
+
+  ev <- evaluate('structure(1, class = "FOO_BAR")')
+  expect_output_types(ev, "source")
+})
+
 test_that("has a reasonable print method", {
   f <- function() {
     print("1")

tests/testthat/test-evaluate.R

@@ -86,27 +86,24 @@ test_that("output and plots interleaved correctly", {
   expect_output_types(ev, c("source", "plot", "text", "plot", "text"))
 })
 
-test_that("return value of value handler inserted directly in output list", {
-  skip_if_not_installed("ggplot2")
-
-  ev <- evaluate_('
-    rnorm(10)
-    x <- list("I\'m a list!")
-    suppressPackageStartupMessages(library(ggplot2))
-    ggplot(mtcars, aes(mpg, wt)) + geom_point()
-  ', output_handler = new_output_handler(value = identity)
-  )
-  expect_output_types(ev, c("source", "numeric", "source", "source", "source", "gg"))
+test_that("return value of value handler is ignored", {
+  handler <- new_output_handler(value = identity)
+  ev <- evaluate_(output_handler = handler, '
+    1
+    invisible(1)
+  ')
+  expect_output_types(ev, c("source", "source"))
 })
 
 test_that("invisible values can also be saved if value handler has two arguments", {
-  handler <- new_output_handler(value = function(x, visible) {
-    x  # always returns a visible value
-  })
+  handler <- new_output_handler(value = function(x, visible) cat(x))
   expect_true(show_value(handler, FALSE))
 
-  ev <- evaluate("x<-1:10", output_handler = handler)
-  expect_output_types(ev, c("source", "integer"))
+  ev <- evaluate_(output_handler = handler, '
+    1
+    invisible(1)
+  ')
+  expect_output_types(ev, c("source", "text", "source", "text"))
 })
 
 test_that("multiple expressions on one line can get printed as expected", {

tests/testthat/test-replay.R

@@ -1,15 +1,3 @@
-test_that("replay() should work when print() returns visible NULLs", {
-  old <- options(prompt = "> ")
-  on.exit(options(old), add = TRUE)
-
-  # need to put S3 method in global namespace otherwise it isn't found
-  assign("print.FOO_BAR", function(x, ...) NULL, envir = globalenv())
-  on.exit(rm(print.FOO_BAR, envir = globalenv()), add = TRUE)
-
-  ret <- evaluate('structure(1, class = "FOO_BAR")')
-  expect_snapshot(replay(ret))
-})
-
 test_that("format_condition handles different types of warning", {
   expect_snapshot({
     w1 <- simpleWarning("This is a warning")