From 3892ccd1e1b5029cc3dd074666fb148ce8a98a85 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 18 Jul 2019 10:08:14 -0500 Subject: [PATCH 1/2] Implement verify_output() Fixes #782. Fixes #834. --- DESCRIPTION | 5 +- NAMESPACE | 7 ++ R/expect-known.R | 50 +++++----- R/verify-output.R | 108 ++++++++++++++++++++++ man/verify_output.Rd | 42 +++++++++ tests/testthat/test-verify-conditions.txt | 12 +++ tests/testthat/test-verify-output.R | 27 ++++++ tests/testthat/test-verify-output.txt | 7 ++ 8 files changed, 234 insertions(+), 24 deletions(-) create mode 100644 R/verify-output.R create mode 100644 man/verify_output.Rd create mode 100644 tests/testthat/test-verify-conditions.txt create mode 100644 tests/testthat/test-verify-output.R create mode 100644 tests/testthat/test-verify-output.txt diff --git a/DESCRIPTION b/DESCRIPTION index 46552ec08..c2d3eaf89 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,6 +19,7 @@ Imports: cli, crayon (>= 1.3.4), digest, + evaluate, magrittr, methods, praise, @@ -33,7 +34,8 @@ Suggests: rmarkdown, usethis, vctrs (>= 0.1.0), - xml2 + xml2, + testthat (>= 2.1.0) VignetteBuilder: knitr Encoding: UTF-8 Roxygen: list(markdown = TRUE) @@ -104,4 +106,5 @@ Collate: 'try-again.R' 'utils-io.R' 'utils.R' + 'verify-output.R' 'watcher.R' diff --git a/NAMESPACE b/NAMESPACE index f08166e66..6da5abdc5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,12 @@ S3method(format,expectation_error) S3method(format,expectation_success) S3method(format,mismatch_character) S3method(format,mismatch_numeric) +S3method(output_replay,character) +S3method(output_replay,error) +S3method(output_replay,message) +S3method(output_replay,recordedplot) +S3method(output_replay,source) +S3method(output_replay,warning) S3method(print,comparison) S3method(print,expectation) S3method(print,mismatch_character) @@ -160,6 +166,7 @@ export(testthat_examples) export(throws_error) export(try_again) export(use_catch) +export(verify_output) export(watch) export(with_mock) export(with_reporter) diff --git a/R/expect-known.R b/R/expect-known.R index afa72d8fb..52f1a3853 100644 --- a/R/expect-known.R +++ b/R/expect-known.R @@ -52,34 +52,38 @@ expect_known_output <- function(object, file, act$lab <- label %||% quo_label(act$quo) act <- append(act, eval_with_output(object, print = print, width = width)) - if (!file.exists(file)) { + compare_file(file, act$out, update = update, info = info, ...) + invisible(act$val) +} + +compare_file <- function(path, lines, ..., update = TRUE, info = NULL) { + if (!file.exists(path)) { warning("Creating reference output", call. = FALSE) - write_lines(act$out, file) + write_lines(lines, path) succeed() - } else { - ref_out <- read_lines(file) - if (update) { - write_lines(act$out, file) - if (!all_utf8(act$out)) { - warning("New reference output is not UTF-8 encoded", call. = FALSE) - } - } - if (!all_utf8(ref_out)) { - warning("Reference output is not UTF-8 encoded", call. = FALSE) - } + return() + } - comp <- compare(act$out, enc2native(ref_out), ...) - expect( - comp$equal, - sprintf( - "%s has changed from known value recorded in %s.\n%s", - act$lab, encodeString(file, quote = "'"), comp$message - ), - info = info - ) + old_lines <- read_lines(path) + if (update) { + write_lines(lines, path) + if (!all_utf8(lines)) { + warning("New reference output is not UTF-8 encoded", call. = FALSE) + } + } + if (!all_utf8(old_lines)) { + warning("Reference output is not UTF-8 encoded", call. = FALSE) } - invisible(act$val) + comp <- compare(lines, enc2native(old_lines), ...) + expect( + comp$equal, + sprintf( + "Results have changed from known value recorded in %s.\n%s", + encodeString(path, quote = "'"), comp$message + ), + info = info + ) } #' @export diff --git a/R/verify-output.R b/R/verify-output.R new file mode 100644 index 000000000..ee7eefb9f --- /dev/null +++ b/R/verify-output.R @@ -0,0 +1,108 @@ +#' Verify output +#' +#' This is a regression test records interwoven code and output into a file, +#' similar to Rmd. It's designed particularly for testing print methods and +#' error messages, where the primary goal is to ensure that the output is +#' helpful to a human. Obviously, there's no way to test that automatically, +#' so the best we can do is make the results explicit by saving to a text file. +#' This makes the presentation easier to see in code reviews, and avoids +#' changing it accidentally. +#' +#' @section CRAN: +#' On CRAN, `verify_output()` will not fail if the output changes. This is +#' beause tests of print methods and error messages are often fragile due to +#' implicit dependencies on other packages, and failure does not imply +#' incorrect computation, just a change in presentation. +#' +#' @section Differences to Rmd: +#' `verify_output()` can only capture the abstract syntax tree, losing all +#' whitespace and comments. To mildy offset this limitation, bare string +#' are turned into comments. +#' +#' @param path Path to save file. Typically this will be a call to +#' [test_path()] so that the same path when the code is run interactively. +#' @param code Code to execute. +#' @param width Width of console output +#' @param crayon Enable crayon package colouring? +#' @export +verify_output <- function(path, code, width = 80, crayon = FALSE) { + code <- enquo(code) + + env <- get_env(code) + expr <- get_expr(code) + + if (is_call(expr, "{")) { + exprs <- as.list(expr[-1]) + } else { + exprs <- list(expr) + } + + exprs <- lapply(exprs, function(x) if (is.character(x)) paste0("# ", x) else expr_deparse(x)) + source <- unlist(exprs, recursive = FALSE) + + withr::local_options(list(width = width, crayon.enabled = crayon)) + withr::local_envvar(list(RSTUDIO_CONSOLE_WIDTH = width)) + + results <- evaluate::evaluate(source, envir = env) + output <- unlist(lapply(results, output_replay)) + + if (!interactive()) { + skip_on_cran() + } + compare_file(path, output, update = TRUE) + invisible() +} + + +output_replay <- function(x) { + UseMethod("output_replay", x) +} + +#' @export +output_replay.character <- function(x) { + sub("\n$", "", x) +} + +#' @export +output_replay.source <- function(x) { + lines <- strsplit(x$src, "\n")[[1]] + n <- length(lines) + + lines[1] <- paste0("> ", lines[1]) + if (n > 1) { + lines[2:n] <- paste0("+ ", lines[2:n]) + } + + lines +} + +#' @export +output_replay.error <- function(x) { + if (is.null(x$call)) { + paste0("Error: ", x$message) + } else { + call <- deparse(x$call) + paste0("Error in ", call, ": ", x$message) + } +} + +#' @export +output_replay.warning <- function(x) { + if (is.null(x$call)) { + paste0("Warning: ", x$message) + } else { + call <- deparse(x$call) + paste0("Warning in ", call, ": ", x$message) + } +} + +#' @export +output_replay.message <- function(x) { + # Messages are the only conditions where a new line is appended automatically + paste0("Message: ", sub("\n$", "", x$message)) +} + +#' @export +output_replay.recordedplot <- function(x) { + abort("Plots are not supported") +} diff --git a/man/verify_output.Rd b/man/verify_output.Rd new file mode 100644 index 000000000..340954c52 --- /dev/null +++ b/man/verify_output.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/verify-output.R +\name{verify_output} +\alias{verify_output} +\title{Verify output} +\usage{ +verify_output(path, code, width = 80, crayon = FALSE) +} +\arguments{ +\item{path}{Path to save file. Typically this will be a call to +\code{\link[=test_path]{test_path()}} so that the same path when the code is run interactively.} + +\item{code}{Code to execute.} + +\item{width}{Width of console output} + +\item{crayon}{Enable crayon package colouring?} +} +\description{ +This is a regression test records interwoven code and output into a file, +similar to Rmd. It's designed particularly for testing print methods and +error messages, where the primary goal is to ensure that the output is +helpful to a human. Obviously, there's no way to test that automatically, +so the best we can do is make the results explicit by saving to a text file. +This makes the presentation easier to see in code reviews, and avoids +changing it accidentally. +} +\section{CRAN}{ + +On CRAN, \code{verify_output()} will not fail if the output changes. This is +beause tests of print methods and error messages are often fragile due to +implicit dependencies on other packages, and failure does not imply +incorrect computation, just a change in presentation. +} + +\section{Differences to Rmd}{ + +\code{verify_output()} can only capture the abstract syntax tree, losing all +whitespace and comments. To mildy offset this limitation, bare string +are turned into comments. +} + diff --git a/tests/testthat/test-verify-conditions.txt b/tests/testthat/test-verify-conditions.txt new file mode 100644 index 000000000..57145876e --- /dev/null +++ b/tests/testthat/test-verify-conditions.txt @@ -0,0 +1,12 @@ +> message("Message") +Message: Message +> # With calls +> warning("Warning") +Warning in eval(expr, envir, enclos): Warning +> stop("Error") +Error in eval(expr, envir, enclos): Error +> # Without calls +> warning("Warning", call. = FALSE) +Warning: Warning +> stop("Error", call. = FALSE) +Error: Error diff --git a/tests/testthat/test-verify-output.R b/tests/testthat/test-verify-output.R new file mode 100644 index 000000000..d6e62d9b3 --- /dev/null +++ b/tests/testthat/test-verify-output.R @@ -0,0 +1,27 @@ +test_that("can record all types of output", { + verify_output(test_path("test-verify-output.txt"), { + "Output" + 1 + 2 + invisible(1:10) + 12345678 + 12345678 + 12345678 + 12345678 + 12345678 + 12345678 + + 12345678 + 12345678 + 12345678 + 12345678 + 12345678 + }) +}) + +test_that("can record all types of output", { + verify_output(test_path("test-verify-conditions.txt"), { + message("Message") + + "With calls" + warning("Warning") + stop("Error") + + "Without calls" + warning("Warning", call. = FALSE) + stop("Error", call. = FALSE) + }) +}) + +test_that("can't record plots", { + expect_error(verify_output("path", plot(1:10)), "Plots") +}) diff --git a/tests/testthat/test-verify-output.txt b/tests/testthat/test-verify-output.txt new file mode 100644 index 000000000..6c873eddc --- /dev/null +++ b/tests/testthat/test-verify-output.txt @@ -0,0 +1,7 @@ +> # Output +> 1 + 2 +[1] 3 +> invisible(1:10) +> 12345678 + 12345678 + 12345678 + 12345678 + 12345678 + 12345678 + 12345678 + ++ 12345678 + 12345678 + 12345678 + 12345678 +[1] 135802458 From 0f5a8a84f84788add2bdc01fb90ec37e3edbbe23 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 19 Jul 2019 12:39:06 -0500 Subject: [PATCH 2/2] Process feedback from @jimhester --- DESCRIPTION | 3 +-- R/verify-output.R | 6 +++--- tests/testthat/test-verify-output.R | 1 + 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index c2d3eaf89..3bc0a927e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -34,8 +34,7 @@ Suggests: rmarkdown, usethis, vctrs (>= 0.1.0), - xml2, - testthat (>= 2.1.0) + xml2 VignetteBuilder: knitr Encoding: UTF-8 Roxygen: list(markdown = TRUE) diff --git a/R/verify-output.R b/R/verify-output.R index ee7eefb9f..c880ba4b5 100644 --- a/R/verify-output.R +++ b/R/verify-output.R @@ -37,12 +37,12 @@ verify_output <- function(path, code, width = 80, crayon = FALSE) { exprs <- list(expr) } - exprs <- lapply(exprs, function(x) if (is.character(x)) paste0("# ", x) else expr_deparse(x)) - source <- unlist(exprs, recursive = FALSE) - withr::local_options(list(width = width, crayon.enabled = crayon)) withr::local_envvar(list(RSTUDIO_CONSOLE_WIDTH = width)) + exprs <- lapply(exprs, function(x) if (is.character(x)) paste0("# ", x) else expr_deparse(x)) + source <- unlist(exprs, recursive = FALSE) + results <- evaluate::evaluate(source, envir = env) output <- unlist(lapply(results, output_replay)) diff --git a/tests/testthat/test-verify-output.R b/tests/testthat/test-verify-output.R index d6e62d9b3..c3096f464 100644 --- a/tests/testthat/test-verify-output.R +++ b/tests/testthat/test-verify-output.R @@ -23,5 +23,6 @@ test_that("can record all types of output", { }) test_that("can't record plots", { + skip_if(interactive()) expect_error(verify_output("path", plot(1:10)), "Plots") })