has_dirname -> has_basename

Author: krlmlr

NAMESPACE

@@ -19,8 +19,8 @@ export(find_rstudio_root_file)
 export(find_testthat_root_file)
 export(from_wd)
 export(get_root_desc)
+export(has_basename)
 export(has_dir)
-export(has_dirname)
 export(has_file)
 export(has_file_pattern)
 export(is.root_criterion)

R/has-file.R

@@ -101,21 +101,22 @@ has_file_pattern <- function(pattern, contents = NULL, n = -1L) {
 }
 
 #' @details
-#' The `has_dirname()` function constructs a criterion that checks if the
-#' [base::dirname()] has a specific name.
+#' The `has_basename()` function constructs a criterion that checks if the
+#' [base::basename()] of the root directory has a specific name,
+#' with support for case-insensitive file systems.
 #'
 #' @rdname root_criterion
-#' @param dirname A directory name, without subdirectories
+#' @param basename A directory name, without subdirectories
 #' @export
-has_dirname <- function(dirname, subdir = NULL) {
-  force(dirname)
+has_basename <- function(basename, subdir = NULL) {
+  force(basename)
 
   testfun <- eval(bquote(function(path) {
     # Support case insensitive file systems.
-    tolower(basename(path)) == tolower(.(dirname)) && dir.exists(file.path(dirname(path), .(dirname)))
+    tolower(basename(path)) == tolower(.(basename)) && dir.exists(file.path(dirname(path), .(basename)))
   }))
 
-  desc <- paste0("directory name is `", dirname, "`")
+  desc <- paste0("directory name is `", basename, "`")
 
   root_criterion(testfun, desc, subdir = subdir)
 }
@@ -145,7 +146,7 @@ is_svn_root <- has_dir(".svn")
 is_vcs_root <- is_git_root | is_svn_root
 
 #' @export
-is_testthat <- has_dirname("testthat", c("tests/testthat", "testthat"))
+is_testthat <- has_basename("testthat", c("tests/testthat", "testthat"))
 
 #' @export
 from_wd <- root_criterion(function(path) TRUE, "from current working directory")

man/root_criterion.Rd

@@ -115,7 +115,7 @@ test_that("has_dir", {
   )
 })
 
-test_that("has_dirname", {
+test_that("has_basename", {
   wd <- normalizePath(getwd(), winslash = "/")
   hierarchy <- function(n = 0L) {
     do.call(file.path, list(wd, "hierarchy", "a", "b", "c")[seq_len(n + 1L)])
@@ -126,19 +126,19 @@ test_that("has_dirname", {
 
   mockr::with_mock(
     is_root = function(x) x == stop_path,
-    expect_equal(find_root(has_dirname("a"), path = path), hierarchy(2L)),
-    expect_equal(find_root(has_dirname("b"), path = path), hierarchy(3L)),
+    expect_equal(find_root(has_basename("a"), path = path), hierarchy(2L)),
+    expect_equal(find_root(has_basename("b"), path = path), hierarchy(3L)),
     expect_equal(
-      find_root_file("c", criterion = has_dirname("b"), path = path),
+      find_root_file("c", criterion = has_basename("b"), path = path),
       file.path(hierarchy(3L), "c")
     ),
-    expect_equal(find_root(has_dirname("c"), path = path), hierarchy(4L)),
+    expect_equal(find_root(has_basename("c"), path = path), hierarchy(4L)),
     expect_error(
-      find_root(has_dirname("d"), path = path),
+      find_root(has_basename("d"), path = path),
       "No root directory found.* is `.*`"
     ),
     expect_error(
-      find_root(has_dirname("rprojroot.Rproj"), path = path),
+      find_root(has_basename("rprojroot.Rproj"), path = path),
       "No root directory found.* is `.*`"
     ),
     TRUE