Feedback from code review

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).
 

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,25 +72,27 @@ 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
     }
   }
 
   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]

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()

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
 

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)
 })