Use a better helper for testing output types

And eliminate tests of length if we're testing the output types

R/output.R

@@ -43,8 +43,6 @@ new_source <- function(src, call, handler = NULL) {
   }
 }
 
-classes <- function(x) vapply(x, function(x) class(x)[1], character(1))
-
 render <- function(x) if (isS4(x)) methods::show(x) else print(x)
 
 #' Custom output handlers

tests/testthat/helper.R

@@ -0,0 +1,22 @@
+output_type <- function(x) {
+  if (is.character(x)) {
+    "text"
+  } else if (inherits(x, "error")) {
+    "error"
+  } else if (inherits(x, "warning")) {
+    "warning"
+  } else if (inherits(x, "message")) {
+    "message"
+  } else if (inherits(x, "recordedplot")) {
+    "plot"
+  } else if (inherits(x, "source")) {
+    "source"
+  } else {
+    class(x)[[1]]
+  }
+}
+output_types <- function(x) vapply(x, output_type, character(1))
+
+expect_output_types <- function(x, types) {
+  expect_equal(output_types(x), types)
+}

tests/testthat/test-evaluate.R

@@ -1,15 +1,14 @@
 test_that("file with only comments runs", {
   ev <- evaluate(file("comment.R"))
-  expect_length(ev, 2)
-
-  expect_equal(classes(ev), c("source", "source"))
+
+  expect_output_types(ev, c("source", "source"))
 })
 
 test_that("data sets loaded", {
   skip_if_not_installed("lattice")
 
   ev <- evaluate(file("data.R"))
-  expect_length(ev, 3)
+  expect_output_types(ev, c("source", "source", "text"))
 })
 
 # # Don't know how to implement this
@@ -20,7 +19,8 @@ test_that("data sets loaded", {
 
 test_that("terminal newline not needed", {
   ev <- evaluate("cat('foo')")
-  expect_length(ev, 2)
+
+  expect_output_types(ev, c("source", "text"))
   expect_equal(ev[[2]], "foo")
 })
 
@@ -39,36 +39,34 @@ test_that("errors during printing visible values are captured", {
   a <- new('A', function() b)
 
   ev <- evaluate("a")
-  expect_s3_class(ev[[2]], "error")
+  expect_output_types(ev, c("source", "error"))
 })
 
 test_that("options(warn = -1) suppresses warnings", {
   ev <- evaluate("op = options(warn = -1); warning('hi'); options(op)")
-  expect_equal(classes(ev), "source")
+  expect_output_types(ev, "source")
 })
 
 test_that("options(warn = 0) and options(warn = 1) produces warnings", {
   ev <- evaluate("op = options(warn = 0); warning('hi'); options(op)")
-  expect_equal(classes(ev), c("source", "simpleWarning"))
+  expect_output_types(ev, c("source", "warning"))
 
   ev <- evaluate("op = options(warn = 1); warning('hi'); options(op)")
-  expect_equal(classes(ev), c("source", "simpleWarning"))
+  expect_output_types(ev, c("source", "warning"))
 })
 
 # See https://github.com/r-lib/evaluate/pull/81#issuecomment-367685196
 # test_that("options(warn = 2) produces errors instead of warnings", {
 #   ev_warn_2 <- evaluate("op = options(warn = 2); warning('hi'); options(op)")
-#   expect_equal(classes(ev_warn_2), c("source", "simpleError"))
+#   expect_output_types(ev_warn_2, c("source", "error"))
 # })
 
 test_that("output and plots interleaved correctly", {
   ev <- evaluate(file("interleave-1.R"))
-  expect_equal(classes(ev),
-               c("source", "character", "recordedplot", "character", "recordedplot"))
+  expect_output_types(ev, c("source", "text", "plot", "text", "plot"))
 
   ev <- evaluate(file("interleave-2.R"))
-  expect_equal(classes(ev),
-               c("source", "recordedplot", "character", "recordedplot", "character"))
+  expect_output_types(ev, c("source", "plot", "text", "plot", "text"))
 })
 
 test_that("return value of value handler inserted directly in output list", {
@@ -78,28 +76,26 @@ test_that("return value of value handler inserted directly in output list", {
     file("raw-output.R"),
     output_handler = new_output_handler(value = identity)
   )
-  expect_equal(
-    classes(ev),
-    c("source", "numeric", "source", "source", "source", "gg")
-  )
+  expect_output_types(ev, c("source", "numeric", "source", "source", "source", "gg"))
 })
 
 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
   })
   ev <- evaluate("x<-1:10", output_handler = handler)
-  expect_equal(classes(ev), c("source", "integer"))
+  expect_output_types(ev, c("source", "integer"))
 })
 
 test_that("multiple expressions on one line can get printed as expected", {
   ev <- evaluate("x <- 1; y <- 2; x; y")
-  expect_equal(classes(ev), c("source", "character", "character"))
+  expect_output_types(ev, c("source", "text", "text"))
 })
 
 test_that("multiple lines of comments do not lose the terminating \\n", {
   ev <- evaluate("# foo\n#bar")
-  expect_equal(ev[[1]][["src"]], "# foo\n")
+  expect_output_types(ev, c("source", "source"))
+  expect_equal(ev[[1]]$src, "# foo\n")
 })
 
 test_that("user can register calling handlers", {

tests/testthat/test-graphics.R

@@ -1,115 +1,98 @@
 test_that("single plot is captured", {
   ev <- evaluate(file("plot.R"))
-  expect_length(ev, 2)
-  expect_equal(classes(ev), c("source", "recordedplot"))
+  expect_output_types(ev, c("source", "plot"))
 })
 
 test_that("ggplot is captured", {
   skip_if_not_installed("ggplot2")
 
   ev <- evaluate(file("ggplot.R"))
-  expect_length(ev, 3)
-  expect_equal(classes(ev), c("source", "source", "recordedplot"))
+  expect_output_types(ev, c("source", "source", "plot"))
 })
 
 test_that("plot additions are captured", {
   ev <- evaluate(file("plot-additions.R"))
-  expect_length(ev, 4)
-
-  expect_equal(
-    classes(ev),
-    c("source", "recordedplot", "source", "recordedplot")
-  )
+  expect_output_types(ev, c("source", "plot", "source", "plot"))
 })
 
 test_that("blank plots by plot.new() are preserved", {
   ev <- evaluate(file("plot-new.R"))
-  expect_length(ev, 10)
-
-  expect_equal(
-    classes(ev),
-    rep(c("source", "recordedplot"), 5)
+  expect_output_types(ev, rep(c("source", "plot"), 5)
   )
 })
 
 test_that("base plots in a single expression are captured", {
   ev <- evaluate(file("plot-loop.R"))
-  expect_length(ev, 4)
-
-  expect_equal(classes(ev), c("source", rep("recordedplot", 3)))
+  expect_output_types(ev, c("source", "plot", "plot", "plot"))
 })
 
 test_that("ggplot2 plots in a single expression are captured", {
   skip_if_not_installed("ggplot2")
 
   ev <- evaluate(file("ggplot-loop.R"))
-  expect_length(ev, 4)
-
-  expect_equal(classes(ev), c(rep("source", 2), rep("recordedplot", 2)))
+  expect_output_types(ev, c("source", "source", "plot", "plot"))
 })
 
 test_that("Empty ggplot should not be recorded", {
   skip_if_not_installed("ggplot2")
   ev <- evaluate(file(test_path("ggplot-empty-1.R")))
-  expect_identical(classes(ev), c(
-    "source", "source",
-    if (packageVersion("ggplot2") > "3.3.6") "rlang_error" else "simpleError"
-  ))
+  expect_output_types(ev, c("source", "source", "error"))
+
   ev <- evaluate(file(test_path("ggplot-empty-2.R")))
-  expect_identical(classes(ev), c("source", "source", "rlang_error"))
+  expect_output_types(ev, c("source", "source", "error"))
 })
 
 test_that("multirow graphics are captured only when complete", {
   ev <- evaluate(file("plot-multi.R"))
 
-  expect_equal(classes(ev), c(rep("source", 5), "recordedplot"))
+  expect_output_types(ev, c(rep("source", 5), "plot"))
 })
 
 test_that("multirow graphics are captured on close", {
   ev <- evaluate(file("plot-multi-missing.R"))
 
-  expect_equal(classes(ev), c(rep("source", 4), "recordedplot"))
+  expect_output_types(ev, c(rep("source", 4), "plot"))
 })
 
 test_that("plots are captured in a non-rectangular layout", {
   ev <- evaluate(file("plot-multi-layout.R"))
-  expect_equal(classes(ev), rep(c("source", "recordedplot"), c(1, 3)))
+  expect_output_types(ev, c("source", "plot", "plot", "plot"))
 
   ev <- evaluate(file("plot-multi-layout2.R"))
-  expect_equal(classes(ev), rep(c("source", "recordedplot"), c(4, 2)))
+  expect_output_types(ev, rep(c("source", "plot"), c(4, 2)))
 })
 
 test_that("changes in parameters don't generate new plots", {
   ev <- evaluate(file("plot-par.R"))
-  expect_equal(
-    classes(ev),
-    c("source", "recordedplot", "source", "source", "recordedplot")
-  )
+  expect_output_types(ev, c("source", "plot", "source", "source", "plot"))
 })
 
 test_that("plots in a loop are captured even the changes seem to be from par only", {
   ev <- evaluate(file("plot-par2.R"))
-  expect_equal(classes(ev), c("source", "recordedplot")[c(1, 2, 1, 1, 2, 2, 2)])
+  expect_output_types(
+    ev,
+    c("source", "plot", "source", "source", "plot", "plot", "plot")
+  )
 })
 
 test_that("strwidth()/strheight() should not produce new plots", {
   ev <- evaluate(file("plot-strwidth.R"))
-  expect_equal(classes(ev), rep(c("source", "recordedplot"), c(4, 1)))
+  expect_output_types(ev, c("source", "source", "source", "source", "plot"))
 })
 
 test_that("clip() does not produce new plots", {
   ev <- evaluate(file("plot-clip.R"))
-  expect_equal(classes(ev), c("source", "recordedplot")[c(1, 2, 1, 1, 2)])
+  expect_output_types(ev, c("source", "plot", "source", "source", "plot"))
 })
 
 test_that("perspective plots are captured", {
   ev <- evaluate(file("plot-persp.R"))
-  expect_equal(classes(ev), rep(c("source", "recordedplot"), c(6, 3)))
+  expect_output_types(ev, rep(c("source", "plot"), c(6, 3)))
 })
 
 test_that("an incomplete plot with a comment in the end is also captured", {
   ev <- evaluate(file("plot-last-comment.R"))
-  expect_equal(classes(ev), rep(c("source", "recordedplot"), c(3, 1)))
+  expect_output_types(ev, rep(c("source", "plot"), c(3, 1)))
 })
 
 # a bug report yihui/knitr#722
@@ -146,5 +129,5 @@ test_that("existing plots will not leak into evaluate()", {
   plot(1, 1)
   ev <- evaluate(c('dev.new()', 'dev.off()', 'plot.new()', 'plot(1:10, 1:10)'))
   dev.off(d)
-  expect_equal(tail(classes(ev), 6), c('source', 'character', 'recordedplot')[c(1, 2, 1, 3, 1, 3)])
+  expect_output_types(ev, c('source', 'text', 'plot')[c(1, 1, 2, 1, 3, 1, 3)])
 })