diff --git a/R/recorder.R b/R/recorder.R index 1fca54b4..0184cb06 100644 --- a/R/recorder.R +++ b/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() diff --git a/R/test-app.R b/R/test-app.R index 18121d72..9f3ae488 100644 --- a/R/test-app.R +++ b/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 ) } diff --git a/R/utils.R b/R/utils.R index 7939863b..5df5d423 100644 --- a/R/utils.R +++ b/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" diff --git a/tests/testthat/apps/two-rmd/doc1.Rmd b/tests/testthat/apps/two-rmd/doc1.Rmd new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/apps/two-rmd/doc2.Rmd b/tests/testthat/apps/two-rmd/doc2.Rmd new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index a1879e23..0016abae 100644 --- a/tests/testthat/test-utils.R +++ b/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") +})