From fd19ffb1a78825628b1db719cf9746e352659fe6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Mon, 20 Nov 2023 11:27:46 +0100 Subject: [PATCH] Drop rprojroot dependency --- DESCRIPTION | 3 +- R/find-package-root.R | 29 ++++++++++++ R/utils.R | 60 ++++++++++++++++++------- tests/testthat/test-find-package-root.R | 40 +++++++++++++++++ 4 files changed, 114 insertions(+), 18 deletions(-) create mode 100644 R/find-package-root.R create mode 100644 tests/testthat/test-find-package-root.R diff --git a/DESCRIPTION b/DESCRIPTION index ab8a0e8..474057f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,8 +20,7 @@ Imports: cli (>= 3.4.0), desc, processx, - R6, - rprojroot + R6 Suggests: covr, cpp11, diff --git a/R/find-package-root.R b/R/find-package-root.R new file mode 100644 index 0000000..1420451 --- /dev/null +++ b/R/find-package-root.R @@ -0,0 +1,29 @@ +find_package_root <- function(path = ".") { + is_root <- function(path) { + identical( + normalizePath(path, winslash = "/"), + normalizePath(dirname(path), winslash = "/") + ) + } + + if (!file.exists(path)) { + stop("Path does not exist: ", path) + } + cur_path <- path + errmsg <- paste0( + "Could not find R package in `", + path, + "` or its parent directories." + ) + max_depth <- 100 + for (i in 1:max_depth) { + if (file.exists(file.path(cur_path, "DESCRIPTION"))) { + return(cur_path) + } else if (is_root(cur_path)) { + stop(errmsg) + } else { + cur_path <- dirname(cur_path) + } + } + stop(errmsg, " Checked ", max_depth, " parent directories.") # nocov +} diff --git a/R/utils.R b/R/utils.R index fa6d6ea..bb17786 100644 --- a/R/utils.R +++ b/R/utils.R @@ -4,7 +4,7 @@ dir.exists <- function(x) { } pkg_path <- function(path = ".") { - rprojroot::find_root("DESCRIPTION", path) + find_package_root(path) } pkg_name <- function(path = ".") { @@ -85,9 +85,15 @@ flag_false_values <- c("false", "no", "off", "0") interpret_envvar_flag <- function(name, default = "false") { env <- tolower(Sys.getenv(name, default)) - if (env %in% flag_true_values) return(TRUE) - if (env %in% flag_false_values) return(FALSE) - if (is.na(env)) return(NA) + if (env %in% flag_true_values) { + return(TRUE) + } + if (env %in% flag_false_values) { + return(FALSE) + } + if (is.na(env)) { + return(NA) + } stop(cli::format_error( "The {.envvar {name}} environment variable must be {.code true} or @@ -116,15 +122,21 @@ should_stop_for_warnings <- function() { get_config_flag_value("stop_for_warnings") } -isFALSE <- function (x) { +isFALSE <- function(x) { is.logical(x) && length(x) == 1L && !is.na(x) && !x } should_add_compiler_flags <- function() { val <- getOption("pkg.build_extra_flags", NULL) - if (isTRUE(val)) return(TRUE) - if (isFALSE(val)) return(FALSE) - if (identical(val, "missing")) return(length(makevars_user()) == 0) + if (isTRUE(val)) { + return(TRUE) + } + if (isFALSE(val)) { + return(FALSE) + } + if (identical(val, "missing")) { + return(length(makevars_user()) == 0) + } if (!is.null(val)) { if (!is_string(val)) { stop(cli::format_error(c( @@ -142,9 +154,15 @@ should_add_compiler_flags <- function() { } val <- Sys.getenv("PKG_BUILD_EXTRA_FLAGS", "true") - if (val %in% flag_true_values) return(TRUE) - if (val %in% flag_false_values) return(FALSE) - if (val %in% "missing") return(length(makevars_user()) == 0) + if (val %in% flag_true_values) { + return(TRUE) + } + if (val %in% flag_false_values) { + return(FALSE) + } + if (val %in% "missing") { + return(length(makevars_user()) == 0) + } stop(cli::format_error(c( "Invalid {.envvar PKG_BUILD_EXTRA_FLAGS} environment variable.", @@ -155,10 +173,16 @@ should_add_compiler_flags <- function() { get_desc_config_flag <- function(path, name) { name <- paste0("Config/build/", name) val <- desc::desc_get(name, file = path) - if (is.na(val)) return(NULL) + if (is.na(val)) { + return(NULL) + } lval <- tolower(val) - if (lval %in% flag_true_values) return(TRUE) - if (lval %in% flag_false_values) return(FALSE) + if (lval %in% flag_true_values) { + return(TRUE) + } + if (lval %in% flag_false_values) { + return(FALSE) + } stop(cli::format_error( "The {.code {name}} entry in {.path DESCRIPTION} must be {.code TRUE} @@ -170,10 +194,14 @@ get_desc_config_flag <- function(path, name) { mkdirp <- function(path, mode = NULL) { if (file.exists(path)) { if (file.info(path)$isdir) { - if (is.null(mode)) return() + if (is.null(mode)) { + return() + } mode <- as.octmode(mode) emode <- as.octmode(file.info(path)$mode) - if (emode == mode) return() + if (emode == mode) { + return() + } ret <- Sys.chmod(path, mode, use_umask = FALSE) if (!ret) { stop(cli::format_error(c( diff --git a/tests/testthat/test-find-package-root.R b/tests/testthat/test-find-package-root.R new file mode 100644 index 0000000..03d4d46 --- /dev/null +++ b/tests/testthat/test-find-package-root.R @@ -0,0 +1,40 @@ +test_that("find_package_root", { + tmp <- tempfile() + on.exit(unlink(tmp, recursive = TRUE), add = TRUE) + mkdirp(file.path(tmp, "a", "b", "c", "d")) + lns <- "Package: this" + writeLines(lns, file.path(tmp, "DESCRIPTION")) + + expect_equal( + readLines(file.path(find_package_root(tmp), "DESCRIPTION")), + lns + ) + + expect_equal( + readLines(file.path( + find_package_root(file.path(tmp, "a")), "DESCRIPTION" + )), + lns + ) + + expect_equal( + readLines(file.path( + find_package_root(file.path(tmp, "a", "b", "c", "d")), "DESCRIPTION" + )), + lns + ) +}) + +test_that("find_package_root errors", { + expect_error( + find_package_root(basename(tempfile())), + "Path does not exist" + ) + + if (!file.exists("/DESCRIPTION")) { + expect_error( + find_package_root("/"), + "Could not find R package" + ) + } +})