From 644ae775f44c3e9b0c9ae28a6bc0d28c0d962fcb Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Tue, 1 Aug 2023 16:40:14 -0500 Subject: [PATCH] Feedback from code review --- NEWS.md | 3 +++ R/source.R | 22 ++++++++++++---------- R/test-files.R | 24 ++++++++++++------------ man/source_file.Rd | 4 ++-- man/test_file.Rd | 10 +++++----- tests/testthat/_snaps/source.md | 10 +++++----- tests/testthat/test-source.R | 13 +++++++------ 7 files changed, 46 insertions(+), 40 deletions(-) diff --git a/NEWS.md b/NEWS.md index b8ef4b194..e1181d426 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,8 @@ # testthat (development version) +* `test_file()` gains a `desc` argument which allows you to run a single + test from a file (#1776). + * `expect_setequal()` correctly displays results when only one of actual and expected is missing values (#1835). diff --git a/R/source.R b/R/source.R index 261d10ed3..898d6501a 100644 --- a/R/source.R +++ b/R/source.R @@ -5,7 +5,7 @@ #' @param path Path to files. #' @param pattern Regular expression used to filter files. #' @param env Environment in which to evaluate code. -#' @param label If not-`NULL`, will run only test with this label. +#' @param desc If not-`NULL`, will run only test with this `desc`ription. #' @param chdir Change working directory to `dirname(path)`? #' @param wrap Automatically wrap all code within [test_that()]? This ensures #' that all expectations are reported, even if outside a test block. @@ -14,7 +14,7 @@ source_file <- function(path, env = test_env(), chdir = TRUE, - label = NULL, + desc = NULL, wrap = TRUE, error_call = caller_env()) { stopifnot(file.exists(path)) @@ -28,7 +28,7 @@ source_file <- function(path, con <- textConnection(lines, encoding = "UTF-8") on.exit(try(close(con), silent = TRUE), add = TRUE) exprs <- parse(con, n = -1, srcfile = srcfile, encoding = "UTF-8") - exprs <- filter_label(exprs, label, error_call = error_call) + exprs <- filter_desc(exprs, desc, error_call = error_call) n <- length(exprs) if (n == 0L) return(invisible()) @@ -60,8 +60,8 @@ source_file <- function(path, } } -filter_label <- function(exprs, label = NULL, error_call = caller_env()) { - if (is.null(label)) { +filter_desc <- function(exprs, desc = NULL, error_call = caller_env()) { + if (is.null(desc)) { return(exprs) } @@ -72,17 +72,19 @@ filter_label <- function(exprs, label = NULL, error_call = caller_env()) { expr <- exprs[[i]] if (!is_call(expr, "test_that", n = 2)) { - include[[i]] <- TRUE + if (!found) { + include[[i]] <- TRUE + } } else { if (!is_string(expr[[2]])) next - test_label <- as.character(expr[[2]]) - if (test_label != label) + test_desc <- as.character(expr[[2]]) + if (test_desc != desc) next if (found) { - abort("Found multiple tests with specified label", call = error_call) + abort("Found multiple tests with specified description", call = error_call) } include[[i]] <- TRUE found <- TRUE @@ -90,7 +92,7 @@ filter_label <- function(exprs, label = NULL, error_call = caller_env()) { } if (!found) { - abort("Failed to find test with specified label", call = error_call) + abort("Failed to find test with specified description", call = error_call) } exprs[include] diff --git a/R/test-files.R b/R/test-files.R index ba24c760e..7f9669e1a 100644 --- a/R/test-files.R +++ b/R/test-files.R @@ -100,7 +100,7 @@ test_dir <- function(path, ) } -#' Run all tests in a single file +#' Run tests in a single file #' #' Helper, setup, and teardown files located in the same directory as the #' test will also be run. See `vignette("special-files")` for details. @@ -109,17 +109,17 @@ test_dir <- function(path, #' @inheritSection test_dir Environments #' @param path Path to file. #' @param ... Additional parameters passed on to `test_dir()` -#' @param label Optionally, supply a string here to run only tests that -#' with this exact label. +#' @param desc Optionally, supply a string here to run only a single +#' tests that with this `desc`ription. #' @export #' @examples #' path <- testthat_example("success") #' test_file(path) -#' test_file(path, label = "some tests have warnings") +#' test_file(path, desc = "some tests have warnings") #' test_file(path, reporter = "minimal") test_file <- function(path, reporter = default_compact_reporter(), - label = NULL, + desc = NULL, package = NULL, ...) { if (!file.exists(path)) { @@ -131,7 +131,7 @@ test_file <- function(path, test_package = package, test_paths = basename(path), reporter = reporter, - label = label, + desc = desc, ... ) } @@ -144,7 +144,7 @@ test_files <- function(test_dir, env = NULL, stop_on_failure = FALSE, stop_on_warning = FALSE, - label = NULL, + desc = NULL, wrap = TRUE, load_package = c("none", "installed", "source"), parallel = FALSE, @@ -181,7 +181,7 @@ test_files <- function(test_dir, env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, - label = label, + desc = desc, wrap = wrap, load_package = load_package, error_call = error_call @@ -198,7 +198,7 @@ test_files_serial <- function(test_dir, env = NULL, stop_on_failure = FALSE, stop_on_warning = FALSE, - label = NULL, + desc = NULL, wrap = TRUE, load_package = c("none", "installed", "source"), error_call = caller_env()) { @@ -215,7 +215,7 @@ test_files_serial <- function(test_dir, test_paths, test_one_file, env = env, - label = label, + desc = desc, wrap = wrap, error_call = error_call ) @@ -324,7 +324,7 @@ test_files_check <- function(results, stop_on_failure = TRUE, stop_on_warning = test_one_file <- function(path, env = test_env(), - label = NULL, + desc = NULL, wrap = TRUE, error_call = caller_env()) { reporter <- get_reporter() @@ -335,7 +335,7 @@ test_one_file <- function(path, path, env = env(env), wrap = wrap, - label = label, + desc = desc, error_call = error_call ) reporter$end_context_if_started() diff --git a/man/source_file.Rd b/man/source_file.Rd index 0b09e8908..04a212f0a 100644 --- a/man/source_file.Rd +++ b/man/source_file.Rd @@ -12,7 +12,7 @@ source_file( path, env = test_env(), chdir = TRUE, - label = NULL, + desc = NULL, wrap = TRUE, error_call = caller_env() ) @@ -38,7 +38,7 @@ source_test_teardown(path = "tests/testthat", env = test_env()) \item{chdir}{Change working directory to \code{dirname(path)}?} -\item{label}{If not-\code{NULL}, will run only test with this label.} +\item{desc}{If not-\code{NULL}, will run only test with this \code{desc}ription.} \item{wrap}{Automatically wrap all code within \code{\link[=test_that]{test_that()}}? This ensures that all expectations are reported, even if outside a test block.} diff --git a/man/test_file.Rd b/man/test_file.Rd index b3c9c2c9f..eb10825a9 100644 --- a/man/test_file.Rd +++ b/man/test_file.Rd @@ -2,12 +2,12 @@ % Please edit documentation in R/test-files.R \name{test_file} \alias{test_file} -\title{Run all tests in a single file} +\title{Run tests in a single file} \usage{ test_file( path, reporter = default_compact_reporter(), - label = NULL, + desc = NULL, package = NULL, ... ) @@ -21,8 +21,8 @@ as a string (e.g. "summary") or as an R6 object See \link{Reporter} for more details and a list of built-in reporters.} -\item{label}{Optionally, supply a string here to run only tests that -with this exact label.} +\item{desc}{Optionally, supply a string here to run only a single +tests that with this \code{desc}ription.} \item{package}{If these tests belong to a package, the name of the package.} @@ -46,6 +46,6 @@ and objects. \examples{ path <- testthat_example("success") test_file(path) -test_file(path, label = "some tests have warnings") +test_file(path, desc = "some tests have warnings") test_file(path, reporter = "minimal") } diff --git a/tests/testthat/_snaps/source.md b/tests/testthat/_snaps/source.md index 051047b26..e5fa8232b 100644 --- a/tests/testthat/_snaps/source.md +++ b/tests/testthat/_snaps/source.md @@ -11,15 +11,15 @@ # can find only matching test Code - filter_label(code, "baz") + filter_desc(code, "baz") Condition Error: - ! Failed to find test with specified label + ! Failed to find test with specified description # preserve srcrefs Code - filter_label(code, "foo") + filter_desc(code, "foo") Output expression(test_that("foo", { # this is a comment @@ -28,8 +28,8 @@ # errors if duplicate labels Code - filter_label(code, "baz") + filter_desc(code, "baz") Condition Error: - ! Found multiple tests with specified label + ! Found multiple tests with specified description diff --git a/tests/testthat/test-source.R b/tests/testthat/test-source.R index 5e9039504..90e3eb0ab 100644 --- a/tests/testthat/test-source.R +++ b/tests/testthat/test-source.R @@ -53,12 +53,13 @@ test_that("can find only matching test", { code <- exprs( f(), test_that("foo", {}), + g(), test_that("bar", {}), - g() + h() ) - expect_equal(filter_label(code, "foo"), code[c(1, 2, 4)]) - expect_equal(filter_label(code, "bar"), code[c(1, 3, 4)]) - expect_snapshot(filter_label(code, "baz"), error = TRUE) + expect_equal(filter_desc(code, "foo"), code[c(1, 2)]) + expect_equal(filter_desc(code, "bar"), code[c(1, 3, 4)]) + expect_snapshot(filter_desc(code, "baz"), error = TRUE) }) test_that("preserve srcrefs", { @@ -67,7 +68,7 @@ test_that("preserve srcrefs", { # this is a comment }) ') - expect_snapshot(filter_label(code, "foo")) + expect_snapshot(filter_desc(code, "foo")) }) @@ -79,5 +80,5 @@ test_that("errors if duplicate labels", { g() ) - expect_snapshot(filter_label(code, "baz"), error = TRUE) + expect_snapshot(filter_desc(code, "baz"), error = TRUE) })