diff --git a/DESCRIPTION b/DESCRIPTION index f86ef89..10e2291 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: box.linters Title: Linters for 'box' Modules -Version: 0.9.1.9001 +Version: 0.9.1.9004 Authors@R: c( person("Ricardo Rodrigo", "Basa", role = c("aut", "cre"), email = "opensource+rodrigo@appsilon.com"), diff --git a/NEWS.md b/NEWS.md index 6d08564..f9bb5dd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # box.linters (development version) +* [Bug fix] Allow relative box module paths (#110) * [Bug fix] Allow multiple `box::use(pkg)` calls (#111) # box.linters 0.9.1 diff --git a/R/box_mod_fun_exists_linter.R b/R/box_mod_fun_exists_linter.R index 261b84e..f371eaf 100644 --- a/R/box_mod_fun_exists_linter.R +++ b/R/box_mod_fun_exists_linter.R @@ -46,7 +46,11 @@ box_mod_fun_exists_linter <- function() { xml <- source_expression$full_xml_parsed_content - mod_fun_not_exists <- check_attached_mod_funs(xml, xpath_module_functions) + working_dir <- get_module_working_dir(source_expression) + + withr::with_dir(working_dir, { + mod_fun_not_exists <- check_attached_mod_funs(xml, xpath_module_functions) + }) lapply(mod_fun_not_exists$xml, function(xml_node) { lintr::xml_nodes_to_lints( diff --git a/R/box_module_usage_helper_functions.R b/R/box_module_usage_helper_functions.R index c65e915..e7ee8b4 100644 --- a/R/box_module_usage_helper_functions.R +++ b/R/box_module_usage_helper_functions.R @@ -181,3 +181,14 @@ get_attached_mod_functions <- function(xml) { text = attached_functions$text ) } + +#' @keywords internal +get_module_working_dir <- function(source_expression) { + box_path <- getOption("box.path") + if (is.null(box_path)) { + working_dir <- fs::path_dir(source_expression$filename) + } else { + working_dir <- getwd() + } + working_dir +} diff --git a/R/box_unused_attached_mod_linter.R b/R/box_unused_attached_mod_linter.R index 615eab8..a3b4ec2 100644 --- a/R/box_unused_attached_mod_linter.R +++ b/R/box_unused_attached_mod_linter.R @@ -79,8 +79,12 @@ box_unused_attached_mod_linter <- function() { xml <- source_expression$full_xml_parsed_content - attached_modules <- get_attached_modules(xml) - attached_three_dots <- get_attached_mod_three_dots(xml) + working_dir <- get_module_working_dir(source_expression) + + withr::with_dir(working_dir, { + attached_modules <- get_attached_modules(xml) + attached_three_dots <- get_attached_mod_three_dots(xml) + }) function_calls <- get_function_calls(xml) glue_object_calls <- get_objects_in_strings(xml) possible_module_calls <- get_object_calls(xml) diff --git a/R/box_unused_attached_mod_obj_linter.R b/R/box_unused_attached_mod_obj_linter.R index 8d6874c..77d1eba 100644 --- a/R/box_unused_attached_mod_obj_linter.R +++ b/R/box_unused_attached_mod_obj_linter.R @@ -61,7 +61,11 @@ box_unused_att_mod_obj_linter <- function() { xml <- source_expression$full_xml_parsed_content - attached_functions_objects <- get_attached_mod_functions(xml) + working_dir <- get_module_working_dir(source_expression) + + withr::with_dir(working_dir, { + attached_functions_objects <- get_attached_mod_functions(xml) + }) function_calls <- get_function_calls(xml) object_calls <- get_object_calls(xml) glue_object_calls <- get_objects_in_strings(xml) diff --git a/tests/testthat/mod/path/relative/module_d.R b/tests/testthat/mod/path/relative/module_d.R new file mode 100644 index 0000000..e01a510 --- /dev/null +++ b/tests/testthat/mod/path/relative/module_d.R @@ -0,0 +1,5 @@ +box::use( + ../to/module_a +) + +module_a$a_fun_a() diff --git a/tests/testthat/mod/path/relative/module_e.R b/tests/testthat/mod/path/relative/module_e.R new file mode 100644 index 0000000..adb467e --- /dev/null +++ b/tests/testthat/mod/path/relative/module_e.R @@ -0,0 +1,5 @@ +box::use( + ../to/module_a[a_fun_a] +) + +a_fun_a() diff --git a/tests/testthat/mod/path/relative/module_f.R b/tests/testthat/mod/path/relative/module_f.R new file mode 100644 index 0000000..c47d2da --- /dev/null +++ b/tests/testthat/mod/path/relative/module_f.R @@ -0,0 +1,5 @@ +box::use( + ../to/module_a[a_fun_ax] +) + +a_fun_a() diff --git a/tests/testthat/test-box_mod_fun_exists_linter.R b/tests/testthat/test-box_mod_fun_exists_linter.R index 61d1c86..12eab08 100644 --- a/tests/testthat/test-box_mod_fun_exists_linter.R +++ b/tests/testthat/test-box_mod_fun_exists_linter.R @@ -69,3 +69,39 @@ test_that("box_mod_fun_exists_linter blocks aliased functions that do not exist lintr::expect_lint(bad_box_usage, list(message = lint_message), linter) }) + +test_that("box_mod_fun_exists_linter allows relative module paths", { + linter <- box_mod_fun_exists_linter() + + withr::with_envvar( + list( + box.path = NULL + ), { + withr::with_dir(file.path(getwd(), "mod", "path", "relative"), { + code <- "box::use(../to/module_a[a_fun_a]) + a_fun_a() + " + + lintr::expect_lint(code, NULL, linters = linter) + }) + } + ) +}) + +test_that("box_mod_fun_exists_linter blocks non-existing functions in relative module paths", { + linter <- box_mod_fun_exists_linter() + lint_message <- rex::rex("Function not exported by module.") + withr::with_envvar( + list( + box.path = NULL + ), { + withr::with_dir(file.path(getwd(), "mod", "path", "relative"), { + code <- "box::use(../to/module_a[not_exist]) + a_fun_a() + " + + lintr::expect_lint(code, list(message = lint_message), linters = linter) + }) + } + ) +}) diff --git a/tests/testthat/test-box_unused_attached_mod_linter.R b/tests/testthat/test-box_unused_attached_mod_linter.R index f9f14e9..45fabdf 100644 --- a/tests/testthat/test-box_unused_attached_mod_linter.R +++ b/tests/testthat/test-box_unused_attached_mod_linter.R @@ -270,6 +270,39 @@ test_that("box_unused_attached_mod_linter blocks unused objects in glue string t lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter) }) +test_that("box_unused_attached_mod_linter works with relative paths", { + linter <- box_unused_attached_mod_linter() + + withr::with_envvar( + list( + box.path = NULL + ), + withr::with_dir(file.path(getwd(), "mod", "path", "relative"), { + code <- "box::use(../to/module_a) + module_a$a_fun_a() + " + + lintr::expect_lint(code, NULL, linters = linter) + }) + ) +}) + +test_that("box_unused_attached_mod_linter detects unused modules with relative paths", { + linter <- box_unused_attached_mod_linter() + lint_message <- rex::rex("Attached module unused.") + + withr::with_envvar( + list( + box.path = NULL + ), + withr::with_dir(file.path(getwd(), "mod", "path", "relative"), { + code <- "box::use(../to/module_a) + " + + lintr::expect_lint(code, list(message = lint_message), linters = linter) + }) + ) +}) # Box test interfaces, not implementations diff --git a/tests/testthat/test-box_unused_attached_mod_obj_linter.R b/tests/testthat/test-box_unused_attached_mod_obj_linter.R index 709b11e..ecffcea 100644 --- a/tests/testthat/test-box_unused_attached_mod_obj_linter.R +++ b/tests/testthat/test-box_unused_attached_mod_obj_linter.R @@ -209,3 +209,38 @@ test_that("box_unused_att_mod_obj_linter blocks unused objects in glue string te lintr::expect_lint(bad_box_usage, list(message = lint_message), linters = linter) }) + +test_that("box_unused_att_mod_obj_linter allows relative module paths", { + linter <- box_unused_att_mod_obj_linter() + + withr::with_envvar( + list( + box.path = NULL + ), { + withr::with_dir(file.path(getwd(), "mod", "path", "relative"), { + code <- "box::use(../to/module_a[a_fun_a]) + a_fun_a() + " + lintr::expect_lint(code, NULL, linters = linter) + + }) + } + ) +}) + +test_that("box_unused_att_mod_obj_linter blocks unused functions from relative module paths", { + linter <- box_unused_att_mod_obj_linter() + lint_message <- rex::rex("Imported function/object unused.") + + withr::with_envvar( + list( + box.path = NULL + ), { + withr::with_dir(file.path(getwd(), "mod", "path", "relative"), { + code <- "box::use(../to/module_a[a_fun_a]) + " + lintr::expect_lint(code, list(message = lint_message), linters = linter) + }) + } + ) +})