allow pkgs in sub-directories for ropensci-review-tools/roreviewapi#64

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: pkgcheck
 Title: rOpenSci Package Checks
-Version: 0.1.2.063
+Version: 0.1.2.068
 Authors@R: c(
     person("Mark", "Padgham", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-2172-5265")),

R/cache.R

@@ -108,16 +108,10 @@ cache_pkgcheck_component <- function (path,
     cache_file <- fs::path (cache_dir, fname)
 
     # rm old components:
-    flist <- list.files (cache_dir,
-        pattern = paste0 (
-            pkg_hash [1], # name of package
-            "\\_"
-        ),
-        full.names = TRUE
-    )
-    flist <- flist [which (!grepl (fname, flist))]
+    flist <- fs::dir_ls (cache_dir, regexp = paste0 (pkg_hash [1], "\\_"))
+    flist <- flist [which (!basename (flist) == fname)]
     if (length (flist) > 0) {
-        chk <- file.remove (flist)
+        chk <- fs::file_delete (flist)
     }
 
     if (fs::file_exists (cache_file) & use_cache) {
@@ -143,7 +137,7 @@ cache_pkgcheck_component <- function (path,
         Sys.unsetenv ("_R_CHECK_FORCE_SUGGESTS_")
 
         # writing to cache_dir fails on some GHA windows machines.
-        if (dir.exists (cache_dir)) {
+        if (fs::dir_exists (cache_dir)) {
             chk <- tryCatch (
                 saveRDS (out, cache_file),
                 error = function (e) NULL

R/path-fns.R

@@ -1,4 +1,3 @@
-
 #' Check and convert path arguments
 #'
 #' Mostly called for side-effects of erroring when path is not root directory of
@@ -22,5 +21,25 @@ convert_path <- function (path = ".") {
         stop (paste0 ("[", path, "] does not appear to be an R package"))
     }
 
-    return (proj_root)
+    proj_root <- tryCatch (
+        rprojroot::find_package_root_file (path = path),
+        error = function (e) NULL
+    )
+    if (is.null (proj_root)) {
+        subdirs <- fs::dir_ls (path, type = "directory")
+        proj_root <- unlist (lapply (subdirs, function (d) {
+            tryCatch (
+                rprojroot::find_root (rprojroot::is_r_package, path = d),
+                error = function (e) NULL
+            )
+        }))
+    }
+
+    if (length (proj_root) != 1L) {
+        cli::cli_abort (
+            "Could not find unambiguous project root from {proj_root}"
+        )
+    }
+
+    return (fs::path (proj_root))
 }

codemeta.json

@@ -8,7 +8,7 @@
   "codeRepository": "https://github.com/ropensci-review-tools/pkgcheck",
   "issueTracker": "https://github.com/ropensci-review-tools/pkgcheck/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.1.2.063",
+  "version": "0.1.2.068",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

tests/testthat/test-path-fns.R

@@ -0,0 +1,21 @@
+testthat::skip_on_os ("windows")
+testthat::skip_on_os ("mac")
+
+# Results on non-Linux systems are equal paths, but not identical
+
+test_that ("pkgcheck", {
+
+    pkgname <- paste0 (
+        sample (c (letters, LETTERS), 8),
+        collapse = ""
+    )
+    pkg_root <- fs::dir_create (fs::path_temp (), pkgname)
+    path <- fs::dir_create (pkg_root, "subdir")
+    f_desc <- fs::path (path, "DESCRIPTION")
+    desc <- system.file ("DESCRIPTION", package = "pkgcheck")
+    fs::file_copy (desc, f_desc, overwrite = TRUE)
+    gert::git_init (pkg_root)
+
+    path_conv <- convert_path (pkg_root)
+    expect_identical (path_conv, path)
+})

tests/testthat/test-pkgcheck.R

@@ -112,6 +112,8 @@ test_that ("pkgcheck", {
     edit_html (f) # from clean-snapshots.R
 
     testthat::expect_snapshot_file (f)
+
+    fs::dir_delete (d)
 })
 
 test_that ("pkgcheck without goodpractice", {
@@ -140,4 +142,6 @@ test_that ("pkgcheck without goodpractice", {
     expect_false (all (items %in% names (checks)))
     items <- c ("pkg", "info", "checks", "meta")
     expect_true (all (items %in% names (checks)))
+
+    fs::dir_delete (d)
 })