Centralise app location logic

And thoroughly test it. Fixes #355

R/recorder.R

@@ -29,23 +29,14 @@ recordTest <- function(app = ".", save_dir = NULL, load_mode = FALSE, seed = NUL
     if (grepl("^http(s?)://", app)) {
       stop("Recording tests for remote apps is not yet supported.")
     } else {
-      app <- app_path(app)
-
-      if (is_rmd(app)) {
-        # If it's an Rmd file, make sure there aren't multiple Rmds in that
-        # directory.
-        if (length(dir(dirname(app), pattern = "\\.Rmd$", ignore.case = TRUE)) > 1) {
-          stop("For testing, only one .Rmd file is allowed per directory.")
-        }
-
-        # Rmds need a random seed. Automatically create one if needed.
-        if (is.null(seed)) {
-          seed <- floor(stats::runif(1, min = 0, max = 1e5))
-        }
+      path <- app_path(app, "app")$app
+
+      # Rmds need a random seed
+      if (is_rmd(path) && is.null(seed)) {
+        seed <- floor(stats::runif(1, min = 0, max = 1e5))
       }
 
-      # It's a path to an app; start the app
-      app <- ShinyDriver$new(app, seed = seed, loadTimeout = loadTimeout, shinyOptions = shinyOptions)
+      app <- ShinyDriver$new(path, seed = seed, loadTimeout = loadTimeout, shinyOptions = shinyOptions)
       on.exit({
         rm(app)
         gc()

R/test-app.R

@@ -33,36 +33,11 @@ testApp <- function(
   suffix = NULL
 )
 {
-  library(shinytest)
-
-  # appDir could be the path to an .Rmd file. If so, make it point to the actual
-  # directory.
-  if (is_app(appDir)) {
-    app_filename <- NULL
-    appDir       <- appDir
-  } else if (is_rmd(appDir)) {
-    # Fallback for old behaviour
-    app_filename <- basename(appDir)
-    appDir       <- dirname(appDir)
-    if (length(dir(appDir, pattern = "\\.Rmd$", ignore.case = TRUE)) > 1) {
-      stop("For testing, only one .Rmd file is allowed per directory.")
-    }
-  } else {
-    rmds <- dir(appDir, pattern = "\\.Rmd$")
-    if (length(rmds) == 1) {
-      app_filename <- rmds
-    } else {
-      stop(
-        "`appDir` doesn't contain 'app.R', 'server.R', or exactly one '.Rmd'",
-        call. = FALSE
-      )
-    }
-  }
+  path <- app_path(appDir, "appDir")
 
-  testsDir <- findTestsDir(appDir, quiet=FALSE)
+  testsDir <- findTestsDir(path$dir, quiet=FALSE)
   found_testnames <- findTests(testsDir, testnames)
-  found_testnames_no_ext <- sub("\\.[rR]$", "", found_testnames)
-
+  found_testnames_no_ext <-
   if (length(found_testnames) == 0) {
     stop("No test scripts found in ", testsDir)
   }
@@ -83,27 +58,24 @@ testApp <- function(
     # in case they're using some of the same resources.
     gc()
 
-    env <- new.env(parent = .GlobalEnv)
     if (!quiet) {
       message(testname, " ", appendLF = FALSE)
     }
+    env <- new.env(parent = .GlobalEnv)
     source(testname, local = env)
   })
 
   gc()
-
   if (!quiet) message("")  # New line
 
   # Compare all results
-  return(
-    snapshotCompare(
-      appDir,
-      testnames = found_testnames_no_ext,
-      quiet = quiet,
-      images = compareImages,
-      interactive = interactive,
-      suffix = suffix
-    )
+  snapshotCompare(
+    path$dir,
+    testnames = sub("\\.[rR]$", "", found_testnames),
+    quiet = quiet,
+    images = compareImages,
+    interactive = interactive,
+    suffix = suffix
   )
 }
 

R/utils.R

@@ -124,29 +124,38 @@ is_app <- function(path) {
   )
 }
 
-# Given a path, return a path that can be passed to ShinyDriver$new()
-# * If it is a path to an Rmd file including filename (like foo/doc.Rmd), return path unchanged.
-# * If it is a dir containing app.R, server.R, return path unchanged.
-# * If it is a dir containing index.Rmd, return the path with index.Rmd at the end.
-# * Otherwise, throw error.
-app_path <- function(path) {
-  if (grepl("\\.Rmd", path, ignore.case = TRUE)) {
-    return(path)
+app_path <- function(path, arg = "path") {
+  if (!file.exists(path)) {
+    stop(paste0("'", path, "' doesn't exist"), call. = FALSE)
   }
-  if (dir_exists(path)) {
-    if (any(c("app.r", "server.r") %in% tolower(dir(path)))) {
-      return(path)
+
+  if (is_app(path)) {
+    app <- path
+    dir <- path
+  } else if (is_rmd(path)) {
+    # Fallback for old behaviour
+    if (length(dir(dirname(path), pattern = "\\.[Rr]md$")) > 1) {
+      stop("For testing, only one .Rmd file is allowed per directory.")
     }
-    if ("index.Rmd" %in% dir(path)) {
-      return(file.path(path, "index.Rmd"))
+    app <- path
+    dir <- dirname(path)
+  } else {
+    rmds <- dir(path, pattern = "\\.Rmd$", full.names = TRUE)
+    if (length(rmds) != 1) {
+      stop(
+        paste0("`", arg, "` doesn't contain 'app.R', 'server.R', or exactly one '.Rmd'"),
+        call. = FALSE
+      )
+    } else {
+      app <- rmds
+      dir <- dirname(app)
     }
   }
 
-  stop(path, " must be a directory containing app.R, server.R, or index.Rmd; or path to a .Rmd file (including the filename).")
+  list(app = app, dir = dir)
 }
 
 
-
 raw_to_utf8 <- function(data) {
   res <- rawToChar(data)
   Encoding(res) <- "UTF-8"

tests/testthat/test-utils.R

@@ -64,3 +64,35 @@ test_that("parse_url", {
   expect_error(parse_url("http://a.b.com:12ab/"))
   expect_error(parse_url("ftp://a.b.com/"))
 })
+
+test_that("can find three styles of app", {
+  local_edition(3)
+  expect_error(app_path(test_path("apps/foofability")), "doesn't exist")
+
+  expect_equal(
+    app_path(test_path("apps/click-me")),
+    list(
+      app = test_path("apps/click-me"),
+      dir = test_path("apps/click-me")
+    )
+  )
+
+  expect_equal(
+    app_path(test_path("recorded_tests/rmd")),
+    list(
+      app = test_path("recorded_tests/rmd/doc.Rmd"),
+      dir = test_path("recorded_tests/rmd")
+    )
+  )
+
+  expect_equal(
+    app_path(test_path("recorded_tests/rmd/doc.Rmd")),
+    list(
+      app = test_path("recorded_tests/rmd/doc.Rmd"),
+      dir = test_path("recorded_tests/rmd")
+    )
+  )
+
+  expect_error(app_path(test_path("apps/two-rmd")), "exactly one")
+  expect_error(app_path(test_path("apps/two-rmd/doc1.Rmd")), "only one")
+})