Merge pull request #2764 from rstudio/runTests-aggregate

Tweak runTests() output format

NEWS.md

@@ -7,6 +7,10 @@ shiny 1.4.0.9001
 
 ### New features
 
+* `runTests()` is a new function that behaves much like R CMD check. `runTests()` invokes all of the top-level R files in the tests/ directory inside an application, in that application's environment. ([#2585](https://github.com/rstudio/shiny/pull/2585))
+
+* `testServer()` and `testModule()` are two new functions for testing reactive behavior inside server functions and modules, respectively. ([#2682](https://github.com/rstudio/shiny/pull/2682), [#2764](https://github.com/rstudio/shiny/pull/2764))
+
 * The new `moduleServer` function provides a simpler interface for creating and using modules. ([#2773](https://github.com/rstudio/shiny/pull/2773))
 
 ### Minor new features and improvements

R/test.R

@@ -1,3 +1,28 @@
+#' Creates and returns run result data frame.
+#'
+#' @param file Name of the test runner file, a character vector of length 1.
+#' @param pass Whether or not the test passed, a logical vector of length 1.
+#' @param result Value (wrapped in a list) obtained by evaluating `file` or `NA`
+#'   if no value was obtained, such as with `shinytest`.
+#' @param error Error, if any, (and wrapped in a list) that was signaled during
+#'   evaluation of `file`.
+#'
+#' @return A 1-row data frame representing a single test run. `result` and
+#'   `error` are "list columns", or columns that may contain list elements.
+#' @noRd
+result_row <- function(file, pass, result, error) {
+  stopifnot(is.list(result))
+  stopifnot(is.list(error))
+  df <- data.frame(
+    file = file,
+    pass = pass,
+    result = I(result),
+    error = I(error),
+    stringsAsFactors = FALSE
+  )
+  class(df) <- c("shinytestrun", class(df))
+  df
+}
 
 #' Check to see if the given text is a shinytest
 #' Scans for the magic string of `app <- ShinyDriver$new(` as an indicator that this is a shinytest.
@@ -19,6 +44,16 @@ isShinyTest <- function(text){
 #'   expression will be executed. Matching is performed on the file name
 #'   including the extension.
 #'
+#' @return A data frame classed with the supplemental class `"shinytestrun"`.
+#'   The data frame has the following columns:
+#'
+#' | **Name** | **Type** | **Meaning** |
+#' | :-- | :-- | :-- |
+#' | `file` | `character(1)` | File name of the runner script in `tests/` that was sourced. |
+#' | `pass` | `logical(1)` | Whether or not the runner script signaled an error when sourced. |
+#' | `result` | any or `NA` | The return value of the runner, or `NA` if `pass == FALSE`. |
+#' | `error` | any or `NA` | The error signaled by the runner, or `NA` if `pass == TRUE`. |
+#'
 #' @details Historically, [shinytest](https://rstudio.github.io/shinytest/)
 #'   recommended placing tests at the top-level of the `tests/` directory. In
 #'   order to support that model, `testApp` first checks to see if the `.R`
@@ -36,7 +71,7 @@ runTests <- function(appDir=".", filter=NULL){
 
   if (length(runners) == 0){
     message("No test runners found in ", testsDir)
-    return(structure(list(result=NA, files=list()), class="shinytestrun"))
+    return(result_row(character(0), logical(0), list(), list()))
   }
 
   if (!is.null(filter)){
@@ -52,6 +87,7 @@ runTests <- function(appDir=".", filter=NULL){
     isShinyTest(text)
   }, logical(1))
 
+  # See the @details section of the runTests() docs above for why this branch exists.
   if (all(isST)){
     # just call out to shinytest
     # We don't need to message/warn here since shinytest already does it.
@@ -64,16 +100,10 @@ runTests <- function(appDir=".", filter=NULL){
       warning("You've disabled `shiny.autoload.r` via an option but this is not passed through to shinytest. Consider using a _disable_autoload.R file as described at https://rstd.io/shiny-autoload")
     }
 
-    sares <- shinytest::testApp(appDir)
-    res <- list()
-    lapply(sares$results, function(r){
-      e <- NA_character_
-      if (!r$pass){
-        e <- simpleError("Unknown shinytest error")
-      }
-      res[[r$name]] <<- e
-    })
-    return(structure(list(result=all(is.na(res)), files=res), class="shinytestrun"))
+    return(do.call(rbind, lapply(shinytest::testApp(appDir)[["results"]], function(r) {
+      error <- if (r[["pass"]]) NA else simpleError("Unknown shinytest error")
+      result_row(r[["name"]], r[["pass"]], list(NA), list(error))
+    })))
   }
 
   testenv <- new.env(parent=globalenv())
@@ -95,13 +125,17 @@ runTests <- function(appDir=".", filter=NULL){
   setwd(testsDir)
 
   # Otherwise source all the runners -- each in their own environment.
-  fileResults <- list()
-  lapply(runners, function(r){
-    env <- new.env(parent=renv)
-    tryCatch({sourceUTF8(r, envir=env); fileResults[[r]] <<- NA_character_}, error=function(e){
-      fileResults[[r]] <<- e
+  return(do.call(rbind, lapply(runners, function(r) {
+    result <- NA
+    error <- NA
+    pass <- FALSE
+    tryCatch({
+      env <- new.env(parent = renv)
+      result <- sourceUTF8(r, envir = env)
+      pass <- TRUE
+    }, error = function(e) {
+      error <<- e
     })
-  })
-
-  return(structure(list(result=all(is.na(fileResults)), files=fileResults), class="shinytestrun"))
+    result_row(r, pass, list(result), list(error))
+  })))
 }

tests/test-helpers/app1-standard/tests/runner2.R

@@ -1,13 +1,12 @@
 
 b <- 2
 
-
-if (!identical(helper1, "abc")){
+if (!identical(helper1, 123)){
   stop("Missing helper1")
 }
-if (!identical(helper2, 123)){
+if (!identical(helper2, "abc")){
   stop("Missing helper2")
 }
-if (exists("a")){
+if (exists("A")){
   stop("a exists -- are we leaking in between test environments?")
 }

tests/testthat/test-test.R

@@ -52,10 +52,10 @@ test_that("runTests works", {
     file.path(test_path("../test-helpers/app1-standard"), "tests")))
 
   # Check the results
-  expect_equal(res$result, FALSE)
-  expect_length(res$files, 2)
-  expect_equal(res$files[1], list(`runner1.R` = NA_character_))
-  expect_equal(res$files[[2]]$message, "I was told to throw an error")
+  expect_equal(all(res$pass), FALSE)
+  expect_length(res$file, 2)
+  expect_equal(res$file[1], "runner1.R")
+  expect_equal(res[2,]$error[[1]]$message, "I was told to throw an error")
   expect_s3_class(res, "shinytestrun")
 
   # Check that supporting files were loaded
@@ -70,8 +70,8 @@ test_that("runTests works", {
   filesToError <- character(0)
 
   res <- runTestsSpy(test_path("../test-helpers/app1-standard"))
-  expect_equal(res$result, TRUE)
-  expect_equal(res$files, list(`runner1.R` = NA_character_, `runner2.R` = NA_character_))
+  expect_equal(all(res$pass), TRUE)
+  expect_equal(res$file, c("runner1.R", "runner2.R"))
 
   # If autoload is false, it should still load global.R. Because this load happens in the top-level of the function,
   # our spy will catch it.
@@ -115,15 +115,15 @@ test_that("calls out to shinytest when appropriate", {
 
   # Run shinytest with a failure
   res2 <- runTestsSpy(test_path("../test-helpers/app1-standard"))
-  expect_false(res2$result)
-  expect_equal(res2$files, list(test1=NA_character_, test2=simpleError("Unknown shinytest error")))
+  expect_false(all(res2$pass))
+  expect_equivalent(res2$error, list(NA, simpleError("Unknown shinytest error")))
   expect_s3_class(res2, "shinytestrun")
 
   # Run shinytest with all passing
   sares[[2]]$pass <- TRUE
   res2 <- runTestsSpy(test_path("../test-helpers/app1-standard"))
-  expect_true(res2$result)
-  expect_equal(res2$files, list(test1=NA_character_, test2=NA_character_))
+  expect_true(all(res2$pass))
+  expect_equivalent(res2$file, c("test1", "test2"))
   expect_s3_class(res2, "shinytestrun")
 
   # Not shinytests
@@ -157,7 +157,21 @@ test_that("runTests filters", {
 test_that("runTests handles the absence of tests", {
   expect_error(runTests(test_path("../test-helpers/app2-nested")), "No tests directory found")
   expect_message(res <- runTests(test_path("../test-helpers/app6-empty-tests")), "No test runners found in")
-  expect_equal(res$result, NA)
-  expect_equal(res$files, list())
+  expect_equal(res$file, character(0))
+  expect_equal(res$pass, logical(0))
+  expect_equivalent(res$result, list())
+  expect_equivalent(res$error, list())
   expect_s3_class(res, "shinytestrun")
 })
+
+test_that("runTests runs as expected without rewiring", {
+  df <- runTests(appDir = "../test-helpers/app1-standard")
+  expect_equivalent(df, data.frame(
+    file = c("runner1.R", "runner2.R"),
+    pass = c(TRUE, TRUE),
+    result = I(list(1, NULL)),
+    error = I(list(NA, NA)),
+    stringsAsFactors = FALSE
+  ))
+  expect_s3_class(df, "shinytestrun")
+})