From 0d814a7de20d9b5551b413434f628ccebb6a9deb Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 31 Mar 2020 12:27:01 -0700 Subject: [PATCH 1/3] Reduce coincidental use of "aaa" in tests Trying to make it more clear when we use it for a reason related to nested projects --- tests/testthat/test-browse.R | 4 ++-- tests/testthat/test-create.R | 4 ++-- tests/testthat/test-use-course.R | 4 ++-- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-browse.R b/tests/testthat/test-browse.R index 1aea1a5b2..e3f2669bd 100644 --- a/tests/testthat/test-browse.R +++ b/tests/testthat/test-browse.R @@ -11,8 +11,8 @@ test_that("github_home() has fall back", { }) test_that("cran_home() produces canonical URL", { - pkg <- scoped_temporary_package(file_temp("aaa")) - expect_match(cran_home(), "https://cran.r-project.org/package=aaa") + pkg <- scoped_temporary_package(file_temp("abc")) + expect_match(cran_home(), "https://cran.r-project.org/package=abc") expect_match(cran_home("bar"), "https://cran.r-project.org/package=bar") }) diff --git a/tests/testthat/test-create.R b/tests/testthat/test-create.R index cc5907043..6202ce82b 100644 --- a/tests/testthat/test-create.R +++ b/tests/testthat/test-create.R @@ -46,14 +46,14 @@ test_that("can create package in current directory", { ## https://github.com/r-lib/usethis/issues/227 test_that("create_* works w/ non-existing rel path and absolutizes it", { ## take care to provide a **non-absolute** path - path_package <- path_file(file_temp(pattern = "aaa")) + path_package <- path_file(file_temp(pattern = "abc")) withr::with_dir( path_temp(), create_package(path_package, rstudio = FALSE, open = FALSE) ) expect_true(dir_exists(path_temp(path_package))) - path_project <- path_file(file_temp(pattern = "aaa")) + path_project <- path_file(file_temp(pattern = "abc")) withr::with_dir( path_temp(), create_project(path_project, rstudio = FALSE, open = FALSE) diff --git a/tests/testthat/test-use-course.R b/tests/testthat/test-use-course.R index 15ad59c6d..5c0706ca7 100644 --- a/tests/testthat/test-use-course.R +++ b/tests/testthat/test-use-course.R @@ -163,8 +163,8 @@ test_that("create_download_url() works", { test_that("normalize_url() prepends https:// (or not)", { expect_error(normalize_url(1), "is\\.character.*not TRUE") - expect_identical(normalize_url("http://bit.ly/aaa"), "http://bit.ly/aaa") - expect_identical(normalize_url("bit.ly/aaa"), "https://bit.ly/aaa") + expect_identical(normalize_url("http://bit.ly/abc"), "http://bit.ly/abc") + expect_identical(normalize_url("bit.ly/abc"), "https://bit.ly/abc") expect_identical( normalize_url("https://github.com/r-lib/rematch2/archive/master.zip"), "https://github.com/r-lib/rematch2/archive/master.zip" From 0b043d6c00242f3b3f2e81df52927a5452931d82 Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 31 Mar 2020 13:33:17 -0700 Subject: [PATCH 2/3] Start removing the "aaa" and is_testing() magic --- R/create.R | 10 +++++----- R/utils.R | 4 ---- tests/testthat/helper.R | 8 ++------ tests/testthat/test-create.R | 6 ++---- tests/testthat/test-proj.R | 2 +- 5 files changed, 10 insertions(+), 20 deletions(-) diff --git a/R/create.R b/R/create.R index 07d7e4b73..9979f75a9 100644 --- a/R/create.R +++ b/R/create.R @@ -260,16 +260,16 @@ create_from_github <- function(repo_spec, invisible(proj_get()) } +# creates a backdoor we can exploit in tests +nested_is_allowed <- function() FALSE + check_not_nested <- function(path, name) { if (!possibly_in_proj(path)) { return(invisible()) } - ## special case: allow nested project if - ## 1) is_testing() - ## 2) proposed project name matches magic string we build into test projects - ## https://github.com/r-lib/usethis/pull/241 - if (is_testing() && grepl("aaa", name)) { + # we mock this in a few tests, to allow a nested project + if (nested_is_allowed()) { return() } diff --git a/R/utils.R b/R/utils.R index 0c42cb300..1e2d52e08 100644 --- a/R/utils.R +++ b/R/utils.R @@ -57,10 +57,6 @@ is_installed <- function(pkg) { ## mimimalist, type-specific purrr::pluck()'s pluck_chr <- function(l, what) vapply(l, `[[`, character(1), what) -is_testing <- function() { - identical(Sys.getenv("TESTTHAT"), "true") || identical(Sys.getenv("R_COVR"), "true") -} - interactive <- function() { ui_stop( "Internal error: use rlang's {ui_code('is_interactive()')} \\ diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 140cf86b3..b3575b777 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -16,17 +16,13 @@ if (!is.null(session_temp_proj)) { )) } -## putting `pattern` in the package or project name is part of our strategy for -## suspending the nested project check during testing -pattern <- "aaa" - -scoped_temporary_package <- function(dir = file_temp(pattern = pattern), +scoped_temporary_package <- function(dir = file_temp(pattern = "testpkg"), env = parent.frame(), rstudio = FALSE) { scoped_temporary_thing(dir, env, rstudio, "package") } -scoped_temporary_project <- function(dir = file_temp(pattern = pattern), +scoped_temporary_project <- function(dir = file_temp(pattern = "testproj"), env = parent.frame(), rstudio = FALSE) { scoped_temporary_thing(dir, env, rstudio, "project") diff --git a/tests/testthat/test-create.R b/tests/testthat/test-create.R index 6202ce82b..53e25aab9 100644 --- a/tests/testthat/test-create.R +++ b/tests/testthat/test-create.R @@ -1,5 +1,3 @@ -context("create") - test_that("create_package() creates a package", { dir <- scoped_temporary_package() expect_true(possibly_in_proj(dir)) @@ -29,12 +27,12 @@ test_that("create functions return path to new proj, but restore active proj", { test_that("nested package is disallowed, by default", { dir <- scoped_temporary_package() - expect_usethis_error(scoped_temporary_package(path(dir, "abcde")), "anyway") + expect_usethis_error(create_package(path(dir, "abcde")), "anyway") }) test_that("nested project is disallowed, by default", { dir <- scoped_temporary_project() - expect_usethis_error(scoped_temporary_project(path(dir, "abcde")), "anyway") + expect_usethis_error(create_project(path(dir, "abcde")), "anyway") }) test_that("can create package in current directory", { diff --git a/tests/testthat/test-proj.R b/tests/testthat/test-proj.R index 52944115b..6085b8976 100644 --- a/tests/testthat/test-proj.R +++ b/tests/testthat/test-proj.R @@ -186,7 +186,7 @@ test_that("local_project() activates proj til scope ends", { old_project <- proj_get_() on.exit(proj_set_(old_project)) - new_proj <- file_temp(pattern = "aaa") + new_proj <- file_temp(pattern = "localprojtest") create_project(new_proj, rstudio = FALSE, open = FALSE) proj_set_(NULL) From 99452d0d18d2e8fc3a0e00462ec0adc97f54797c Mon Sep 17 00:00:00 2001 From: Jenny Bryan Date: Tue, 31 Mar 2020 15:46:51 -0700 Subject: [PATCH 3/3] Rework how we allow a nested project; work on tests --- R/create.R | 4 ++-- tests/testthat/test-create.R | 32 ++++++++++++++++++++++++++++++-- 2 files changed, 32 insertions(+), 4 deletions(-) diff --git a/R/create.R b/R/create.R index 9979f75a9..ba6b541dd 100644 --- a/R/create.R +++ b/R/create.R @@ -261,7 +261,7 @@ create_from_github <- function(repo_spec, } # creates a backdoor we can exploit in tests -nested_is_allowed <- function() FALSE +allow_nested_project <- function() FALSE check_not_nested <- function(path, name) { if (!possibly_in_proj(path)) { @@ -269,7 +269,7 @@ check_not_nested <- function(path, name) { } # we mock this in a few tests, to allow a nested project - if (nested_is_allowed()) { + if (allow_nested_project()) { return() } diff --git a/tests/testthat/test-create.R b/tests/testthat/test-create.R index 53e25aab9..a9fac71f1 100644 --- a/tests/testthat/test-create.R +++ b/tests/testthat/test-create.R @@ -35,9 +35,37 @@ test_that("nested project is disallowed, by default", { expect_usethis_error(create_project(path(dir, "abcde")), "anyway") }) +test_that("nested package can be created if user really, really wants to", { + parent <- scoped_temporary_package() + with_mock( + # since user can't approve interactively, use the backdoor + `usethis:::allow_nested_project` = function() TRUE, + child <- create_package(path(parent, "fghijk")) + ) + expect_true(possibly_in_proj(child)) + expect_true(is_package(child)) +}) + +test_that("nested project can be created if user really, really wants to", { + parent <- scoped_temporary_project() + with_mock( + # since user can't approve interactively, use the backdoor + `usethis:::allow_nested_project` = function() TRUE, + child <- create_project(path(parent, "fghijk")) + ) + expect_true(possibly_in_proj(child)) + expect_false(is_package(child)) +}) + test_that("can create package in current directory", { - dir <- dir_create(path(file_temp(), "mypackage")) - withr::local_dir(dir) + # doing this "by hand" vs. via withr because Windows appears to be unwilling + # to delete current working directory + newdir <- dir_create(path(file_temp(), "mypackage")) + oldwd <- setwd(newdir) + on.exit({ + setwd(oldwd) + dir_delete(newdir) + }) expect_error_free(create_package(".")) })