Clean up code and tests around nested projects (#1085)

* Reduce coincidental use of "aaa" in tests

Trying to make it more clear when we use it for a reason related to nested projects

* Start removing the "aaa" and is_testing() magic

* Rework how we allow a nested project; work on tests

Author: jennybc

R/create.R

@@ -260,16 +260,16 @@ create_from_github <- function(repo_spec,
   invisible(proj_get())
 }
 
+# creates a backdoor we can exploit in tests
+allow_nested_project <- 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 (allow_nested_project()) {
     return()
   }
 

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()')} \\

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")

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")
 })
 

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,31 +27,59 @@ 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("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("."))
 })
 
 ## 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)

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)
 

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"