From 643c7b6a829cc48d63758c8a76c15f809f2b2464 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Sun, 1 Jul 2018 17:24:47 -0700 Subject: [PATCH] Groom tests * work in session temp dir * shift towards withr functions for local teardown * adopt fs here too * apply styler --- tests/testthat/helper.R | 5 +++ tests/testthat/test-filepaths.R | 18 ++-------- tests/testthat/test-input.R | 29 ++++++++++------ tests/testthat/test-knitr-options.R | 26 +++++++------- tests/testthat/test-outfiles.R | 54 ++++++++++++++++------------- tests/testthat/test-reprex.R | 1 - tests/testthat/test-stdout-stderr.R | 8 +++-- tests/testthat/test-undo.R | 9 +++-- 8 files changed, 79 insertions(+), 71 deletions(-) diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 13283e98..374634d8 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -19,6 +19,11 @@ expect_error_free <- function(...) { expect_error(..., regexp = NA) } +## set wd to session temp dir, execute testing code, restore previous wd +temporarily <- function(env = parent.frame()) { + withr::local_dir(path_temp(), .local_envir = env) +} + ## call during interactive test development to fake being "in tests" and thereby ## cause in-house interactive() to return FALSE test_mode <- function() { diff --git a/tests/testthat/test-filepaths.R b/tests/testthat/test-filepaths.R index 1068ff21..9cb479a1 100644 --- a/tests/testthat/test-filepaths.R +++ b/tests/testthat/test-filepaths.R @@ -9,26 +9,14 @@ test_that("make_filebase() defaults to 'reprex' inside a dir inside tempdir", { }) test_that("make_filebase(outfile = NA) fabricates filebase in wd", { - withr::with_dir( - fs::path_temp(), - x <- make_filebase(outfile = NA, infile = NULL) - ) + x <- make_filebase(outfile = NA, infile = NULL) expect_match(fs::path_file(x), "^reprex") expect_equal(fs::path_dir(x), ".") }) test_that("make_filebase() works from relative infile, outfile", { - withr::with_dir( - fs::path_temp(), - x <- make_filebase(outfile = NA, infile = "abcde") - ) - expect_equal(x, "abcde") - - withr::with_dir( - fs::path_temp(), - x <- make_filebase(outfile = "abcde") - ) - expect_equal(x, "abcde") + expect_equal(make_filebase(outfile = NA, infile = "abcde"), "abcde") + expect_equal(make_filebase(outfile = "abcde"), "abcde") }) test_that("make_filebase() works from absolute infile, outfile", { diff --git a/tests/testthat/test-input.R b/tests/testthat/test-input.R index b792fa28..f6a81fc1 100644 --- a/tests/testthat/test-input.R +++ b/tests/testthat/test-input.R @@ -27,18 +27,20 @@ test_that("reprex: character input works", { test_that("reprex: file input works", { skip_on_cran() - on.exit(file.remove("foo.R")) + temporarily() + withr::local_file("foo.R") write("1:5", "foo.R") expect_match(reprex(input = "foo.R", render = FALSE), "^1:5$", all = FALSE) }) test_that("reprex: file input in a subdirectory works", { skip_on_cran() - on.exit(unlink("foo", recursive = TRUE)) - dir.create("foo") - write("1:5", file.path("foo", "foo.R")) + temporarily() + withr::defer(dir_delete("foo")) + dir_create("foo") + write("1:5", path("foo", "foo.R")) expect_match( - reprex(input = file.path("foo", "foo.R"), render = FALSE), + reprex(input = path("foo", "foo.R"), render = FALSE), "^1:5$", all = FALSE ) @@ -75,9 +77,10 @@ test_that("ingest_input() works", { expect_identical(input[1], ingest_input(input_first_elem)) ## file - on.exit(file.remove("foo.R")) - writeLines(input, "foo.R") - expect_identical(input, ingest_input("foo.R")) + input_file <- path_temp("foo.R") + withr::local_file(input_file) + writeLines(input, input_file) + expect_identical(input, ingest_input(input_file)) }) test_that("newlines in code are protected and uniformly so across venues", { @@ -86,9 +89,13 @@ test_that("newlines in code are protected and uniformly so across venues", { input <- 'paste(letters[1:3], collapse = "\n")\n' chr_input <- reprex(input = input, render = FALSE) - on.exit(file.remove("foo.R")) - writeLines(escape_newlines('paste(letters[1:3], collapse = "\n")'), "foo.R") - path_input <- reprex(input = "foo.R", render = FALSE) + input_file <- path_temp("foo.R") + withr::local_file(input_file) + writeLines( + escape_newlines('paste(letters[1:3], collapse = "\n")'), + input_file + ) + path_input <- reprex(input = input_file, render = FALSE) expr_input <- reprex(paste(letters[1:3], collapse = "\n"), render = FALSE) diff --git a/tests/testthat/test-knitr-options.R b/tests/testthat/test-knitr-options.R index 92ca7829..646dc20c 100644 --- a/tests/testthat/test-knitr-options.R +++ b/tests/testthat/test-knitr-options.R @@ -6,13 +6,12 @@ test_that("chunk options can be overridden", { "(y <- 1:4)", "mean(y)" ) - short_form <- - reprex( - input = src, - opts_chunk = list(collapse = FALSE), - show = FALSE, - advertise = FALSE - ) + short_form <- reprex( + input = src, + opts_chunk = list(collapse = FALSE), + show = FALSE, + advertise = FALSE + ) header <- c( "#+ setup, include = FALSE", "knitr::opts_chunk$set(collapse = FALSE)", @@ -35,13 +34,12 @@ test_that("`comment` is special", { show = FALSE, advertise = FALSE ) - medium_form <- - reprex( - input = src, - opts_chunk = list(comment = "#?#"), - show = FALSE, - advertise = FALSE - ) + medium_form <- reprex( + input = src, + opts_chunk = list(comment = "#?#"), + show = FALSE, + advertise = FALSE + ) header <- c( "#+ setup, include = FALSE", "knitr::opts_chunk$set(comment = '#?#')", diff --git a/tests/testthat/test-outfiles.R b/tests/testthat/test-outfiles.R index 9e6f7efc..ff1937ef 100644 --- a/tests/testthat/test-outfiles.R +++ b/tests/testthat/test-outfiles.R @@ -8,7 +8,8 @@ base_msg <- c( test_that("expected outfiles are written and messaged, venue = 'gh'", { skip_on_cran() - on.exit(file.remove("foo_reprex.R", "foo_reprex.md")) + temporarily() + withr::local_file(c("foo_reprex.R", "foo_reprex.md")) msg <- capture_messages(ret <- reprex(1:5, outfile = "foo", show = FALSE)) expect_identical(msg[1:3], base_msg) expect_match(readLines("foo_reprex.R"), "1:5", all = FALSE) @@ -17,11 +18,8 @@ test_that("expected outfiles are written and messaged, venue = 'gh'", { test_that("expected outfiles are written and messaged, venue = 'R'", { skip_on_cran() - on.exit(file.remove( - "foo_reprex.R", - "foo_reprex.md", - "foo_reprex_rendered.R" - )) + temporarily() + withr::local_file(c("foo_reprex.R", "foo_reprex.md", "foo_reprex_rendered.R")) msg <- capture_messages( ret <- reprex(1:5, outfile = "foo", show = FALSE, venue = "R") ) @@ -37,15 +35,17 @@ test_that("expected outfiles are written and messaged, venue = 'R'", { test_that("`.md` extension is stripped from outfile", { skip_on_cran() - on.exit(file.remove("foo_reprex.R", "foo_reprex.md")) + temporarily() + withr::local_file(c("foo_reprex.R", "foo_reprex.md")) ret <- reprex(1:5, show = FALSE, outfile = "foo.md") - expect_true(file.exists("foo_reprex.R")) - expect_length(list.files(pattern = "foo.md"), 0) + expect_true(file_exists("foo_reprex.R")) + expect_length(dir_ls(regexp = "foo.md"), 0) }) test_that(".R outfile doesn't clobber .R infile", { skip_on_cran() - on.exit(file.remove("foo.R", "foo_reprex.R", "foo_reprex.md")) + temporarily() + withr::local_file(c("foo.R", "foo_reprex.R", "foo_reprex.md")) writeLines("1:5", "foo.R") ret <- reprex(input = "foo.R", show = FALSE, outfile = NA) expect_identical("1:5", readLines("foo.R")) @@ -53,44 +53,48 @@ test_that(".R outfile doesn't clobber .R infile", { test_that("outfiles in a subdirectory works", { skip_on_cran() - on.exit(unlink("foo", recursive = TRUE)) - dir.create("foo") - msg <- capture_messages(ret <- reprex(1:5, outfile = "foo/foo", show = FALSE)) + temporarily() + withr::defer(dir_delete("foo")) + dir_create("foo") + msg <- capture_messages( + ret <- reprex(1:5, outfile = "foo/foo", show = FALSE) + ) exp_msg <- gsub("foo", "foo/foo", base_msg) expect_identical(msg[1:3], exp_msg) }) test_that("outfiles based on input file", { - ## TODO: use withr to set wd to a tempdir skip_on_cran() - on.exit(file.remove("foo.R", "foo_reprex.R", "foo_reprex.md")) + temporarily() + withr::local_file(c("foo.R", "foo_reprex.R", "foo_reprex.md")) writeLines("1:5", "foo.R") - msg <-capture_messages( + msg <- capture_messages( ret <- reprex(input = "foo.R", show = FALSE, outfile = NA) ) - expect_true(file.exists("foo_reprex.md")) + expect_true(file_exists("foo_reprex.md")) expect_identical(msg[1:3], base_msg) }) test_that("outfiles based on tempfile()", { skip_on_cran() - msg <- capture_messages(ret <- reprex( - input = c("x <- 1:3", "min(x)"), - show = FALSE, outfile = NA - )) + temporarily() + msg <- capture_messages( + ret <- reprex(input = c("x <- 1:3", "min(x)"), show = FALSE, outfile = NA) + ) tempbase <- gsub(".*(reprex.*)_.*", "\\1", msg[1]) r_file <- paste0(tempbase, "_reprex.R") md_file <- paste0(tempbase, "_reprex.md") - on.exit(file.remove(r_file, md_file)) - expect_true(file.exists(r_file)) - expect_true(file.exists(md_file)) + withr::local_file(c(r_file, md_file)) + expect_true(file_exists(r_file)) + expect_true(file_exists(md_file)) exp_msg <- gsub("foo", tempbase, base_msg) expect_identical(msg[1:3], exp_msg) }) test_that("pre-existing foo_reprex.R doesn't get clobbered w/o user's OK", { skip_on_cran() - on.exit(file.remove("foo_reprex.R", "foo_reprex.md")) + temporarily() + withr::local_file(c("foo_reprex.R", "foo_reprex.md")) ret <- reprex(1:3, show = FALSE, outfile = "foo") expect_match(readLines("foo_reprex.md"), "1:3", all = FALSE, fixed = TRUE) reprex(max(4:6), show = FALSE, outfile = "foo") diff --git a/tests/testthat/test-reprex.R b/tests/testthat/test-reprex.R index 158f5194..fe78c034 100644 --- a/tests/testthat/test-reprex.R +++ b/tests/testthat/test-reprex.R @@ -26,4 +26,3 @@ test_that("reprex() doesn't leak files by default", { ret <- reprex(readLines("test.txt"), show = FALSE, advertise = FALSE) expect_match(ret, "cannot open file 'test.txt'", all = FALSE) }) - diff --git a/tests/testthat/test-stdout-stderr.R b/tests/testthat/test-stdout-stderr.R index 68030b08..8b9aee26 100644 --- a/tests/testthat/test-stdout-stderr.R +++ b/tests/testthat/test-stdout-stderr.R @@ -2,9 +2,13 @@ context("stdout-stderr") test_that("stdout is captured", { skip_on_cran() - out <- reprex(system2("echo", args = "blah"), std_out_err = TRUE, show = FALSE) + out <- reprex( + system2("echo", args = "blah"), + std_out_err = TRUE, + show = FALSE + ) expect_match(out, "standard output and standard error", all = FALSE) - expect_match(out, "blah", all = FALSE) + expect_match(out, "^blah$", all = FALSE) }) test_that("stdout placeholder appears if nothing is captured", { diff --git a/tests/testthat/test-undo.R b/tests/testthat/test-undo.R index 7c088feb..d5f5566d 100644 --- a/tests/testthat/test-undo.R +++ b/tests/testthat/test-undo.R @@ -110,7 +110,8 @@ test_that("reprex_rescue() can cope with leading whitespace", { test_that("reprex_invert() can write to specific outfile", { skip_on_cran() - on.exit(file.remove("foo_clean.R")) + temporarily() + withr::local_file("foo_clean.R") code <- c("x <- 1:3", "median(x)") invert_me <- reprex(input = code, show = FALSE, advertise = FALSE) out <- reprex_invert(input = invert_me, outfile = "foo") @@ -119,6 +120,7 @@ test_that("reprex_invert() can write to specific outfile", { test_that("reprex_invert() can name its own outfile", { skip_on_cran() + temporarily() code <- c("x <- 1:3", "median(x)") invert_me <- reprex(input = code, show = FALSE, advertise = FALSE) msg <- capture_messages( @@ -126,13 +128,14 @@ test_that("reprex_invert() can name its own outfile", { ) msg <- sub("\n$", "", msg) outfile <- regmatches(msg, regexpr("reprex(.*)", msg)) - on.exit(file.remove(outfile)) + withr::local_file(outfile) expect_identical(readLines(outfile), out) }) test_that("reprex_invert() can name outfile based on input filepath", { skip_on_cran() - on.exit(file.remove(c("a_reprex.R", "a_reprex.md", "a_reprex_clean.R"))) + temporarily() + withr::local_file(c("a_reprex.R", "a_reprex.md", "a_reprex_clean.R")) code <- c("x <- 1:3", "median(x)") reprex(input = code, show = FALSE, advertise = FALSE, outfile = "a") out <- reprex_invert(input = "a_reprex.md", outfile = NA)