New expect_output_file()

NAMESPACE

@@ -67,6 +67,7 @@ export(expect_more_than)
 export(expect_named)
 export(expect_null)
 export(expect_output)
+export(expect_output_file)
 export(expect_s3_class)
 export(expect_s4_class)
 export(expect_silent)

NEWS.md

@@ -1,5 +1,8 @@
 # testthat 1.0.0.9000
 
+* New `expect_output_file()` to compare output of a function
+  with a text file, and optionally update it (#443, @krlmlr).
+
 * Properly scoped use + compilation of C++ unit testing code using
   Catch to `gcc` and `clang` only, as Catch includes code that does
   not strictly conform to the C++98 standard. (@kevinushey)

R/evaluate-promise.R

@@ -101,15 +101,20 @@ get_messages <- function(x) {
 #' @export
 #' @rdname evaluate_promise
 capture_output <- function(code, print = FALSE) {
+  output <- capture_output_as_vector(code, print)
+  paste0(output, collapse = "\n")
+}
+
+capture_output_as_vector <- function(code, print) {
   temp <- file()
-  on.exit(close(temp))
+  on.exit(close(temp), add = TRUE)
 
   result <- with_sink(temp, withVisible(code))
   if (result$visible && print) {
     with_sink(temp, print(result$value))
   }
 
-  paste0(readLines(temp, warn = FALSE), collapse = "\n")
+  readLines(temp, warn = FALSE)
 }
 
 with_sink <- function(connection, code, ...) {

R/expect-output.R

@@ -3,7 +3,8 @@
 #' Use \code{expect_output()}, \code{expect_message()}, \code{expect_warning()},
 #' or \code{expect_error()} to check for specific outputs. Use
 #' \code{expect_silent()} to assert that there should be no output of
-#' any type.
+#' any type. The file-based\code{expect_output_file()} compares the output
+#' to the contents of a text file and optionally updates it.
 #'
 #' @inheritParams expect_that
 #' @inheritParams expect_match
@@ -102,6 +103,27 @@ expect_output <- function(object, regexp = NULL, ..., info = NULL, label = NULL)
 }
 
 
+#' @export
+#' @rdname output-expectations
+#' @param file Path to a "golden" text file that contains the desired output.
+#' @param update Should the "golden" text file be updated? Default: \code{FALSE}.
+expect_output_file <- function(object, file, update = FALSE, ...,
+                               info = NULL, label = NULL) {
+  lab <- make_label(object, label)
+  output <- capture_output_as_vector(object)
+
+  withCallingHandlers(
+    eval(bquote(
+      expect_equal(output, safe_read_lines(.(file)), ..., info = info, label = lab))),
+    expectation = function(e) {
+      if (update && expectation_failure(e)) {
+        tryCatch(writeLines(output, file), error = function(e) NULL)
+      }
+    }
+  )
+}
+
+
 #' @export
 #' @rdname output-expectations
 expect_error <- function(object, regexp = NULL, ..., info = NULL, label = NULL) {

R/utils.R

@@ -26,6 +26,16 @@ rule <- function(..., pad = "-") {
   cat(title, paste(rep(pad, width, collapse = "")), "\n", sep = "")
 }
 
+safe_read_lines <- function(file) {
+  tryCatch(
+    readLines(file, warn = FALSE),
+    error = function(e) {
+      warning(conditionMessage(e), call. = NULL)
+      character()
+    }
+  )
+}
+
 
 # Tools for finding srcrefs -----------------------------------------------
 

tests/testthat/test-expect-output.R

@@ -26,3 +26,29 @@ test_that("multiline outputs captures and matches", {
 test_that("... passed on to grepl", {
   expect_success(expect_output(print("X"), "x", ignore.case = TRUE))
 })
+
+test_that("expect_output_file works, also with incomplete last line", {
+  file <- tempfile()
+  writeLines("Hi!", file)
+  expect_success(expect_output_file(cat("Hi!"), file))
+  expect_success(expect_output_file(cat("Hi!\n"), file))
+  expect_failure(expect_output_file(cat("Hi!\n\n"), file))
+  expect_failure(expect_output_file(cat("oops"), file))
+})
+
+test_that("expect_output_file can update file but does not by default", {
+  file <- tempfile()
+  writeLines("Hi!", file)
+  expect_failure(expect_output_file(cat("oops"), file))
+  expect_equal(readLines(file), "Hi!")
+  expect_failure(expect_output_file(cat("oops"), file, update = TRUE))
+  expect_success(expect_output_file(cat("oops"), file))
+})
+
+test_that("expect_output_file warns if file missing, but can update it", {
+  file <- tempfile()
+  expect_warning(expect_failure(expect_output_file(cat("oops"), file)))
+  expect_false(file.exists(file))
+  expect_warning(expect_failure(expect_output_file(cat("oops"), file, update = TRUE)))
+  expect_success(expect_output_file(cat("oops"), file))
+})

tests/testthat/test-reporter.R

@@ -43,7 +43,8 @@ test_that("reporters produce consistent output", {
 
   save_report <- function(name, reporter = find_reporter(name)) {
     path <- test_path("reporters", paste0(name, ".txt"))
-    capture.output(test_file(test_path("reporters/tests.R"), reporter), file = path)
+    expect_output_file(test_file(test_path("reporters/tests.R"), reporter),
+                       path, update = TRUE)
   }
 
   expect_error(save_report("check"))