diff --git a/.gitignore b/.gitignore index 05069c31..f6f94016 100644 --- a/.gitignore +++ b/.gitignore @@ -15,3 +15,6 @@ Meta /man/_cache /man/macros/eval2.Rd /revdep +/src/*.gcda +*.gcda +*.gcno diff --git a/NAMESPACE b/NAMESPACE index 3ab00bc8..5f50ef03 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,7 @@ # Generated by roxygen2: do not edit by hand S3method("[",pkg_resolution_result) +S3method("[",pkg_scan_deps) S3method("[",pkg_solution_result) S3method("[",pkg_sysreqs_check_result) S3method("[",pkgplan_downloads) @@ -13,6 +14,7 @@ S3method(format,pkg_name_check_sentiment) S3method(format,pkg_name_check_urban) S3method(format,pkg_name_check_wikipedia) S3method(format,pkg_name_check_wiktionary) +S3method(format,pkg_scan_deps) S3method(format,pkg_solution_failures) S3method(format,pkg_solution_result) S3method(format,pkg_sysreqs_check_result) @@ -22,6 +24,7 @@ S3method(print,package_build_error) S3method(print,package_packaging_error) S3method(print,package_uncompress_error) S3method(print,pkg_name_check) +S3method(print,pkg_scan_deps) S3method(print,pkg_solution_result) S3method(print,pkg_sysreqs_check_result) S3method(print,pkginstall_result) diff --git a/R/scan-deps-print.R b/R/scan-deps-print.R new file mode 100644 index 00000000..5ea68b54 --- /dev/null +++ b/R/scan-deps-print.R @@ -0,0 +1,45 @@ +#' @export + +format.pkg_scan_deps <- function(x, ...) { + labels <- c( + prod = "Dependencies", + test = "Test dependencies", + dev = "Development dependencies", + # TODO: generic label for others + NULL + ) + lns <- lapply(seq_along(labels), function(i) { + deps <- x[x$type == names(labels)[i], , drop = FALSE] + if (nrow(deps) == 0) return(NULL) + fls <- tapply(deps$path, deps$package, "c", simplify = FALSE) + fls[] <- lapply(fls, unique) + fls <- vcapply(fls, paste, collapse = ", ") + pkg <- format(names(fls)) + flsw <- cli::console_width() - nchar(pkg[1]) - 5 + c( + "", cli::col_yellow(paste0(labels[i], ":")), + paste0( + cli::col_grey("+ "), + cli::col_blue(pkg), + cli::col_grey(" @ "), + cli::col_silver(cli::ansi_strtrim(fls, flsw)) + ) + ) + }) + + unlist(lns) +} + +#' @export + +print.pkg_scan_deps <- function(x, ...) { + writeLines(format(x, ...)) + invisible(x) +} + +#' @export + +`[.pkg_scan_deps` <- function (x, i, j, drop = FALSE) { + class(x) <- setdiff(class(x), "pkg_scan_deps") + NextMethod("[") +} diff --git a/R/scan-deps.R b/R/scan-deps.R index 62563ae1..78277ed6 100644 --- a/R/scan-deps.R +++ b/R/scan-deps.R @@ -83,13 +83,14 @@ scan_deps <- function(path = ".") { path <- tryCatch(find_project_root(path), error = function(...) path) - paths <- dir(path, pattern = "[.](R|r|Rmd|rmd)$", recursive = TRUE) + paths <- dir(path, pattern = "[.](R|r|Rmd|rmd|qmd)$", recursive = TRUE) full_paths <- normalizePath(file.path(path, paths)) deps_list <- lapply(full_paths, scan_path_deps) deps <- do.call("rbind", c(list(scan_path_deps_empty()), deps_list)) # write back the relative paths deps$path <- paths[match(deps$path, full_paths)] deps$type <- get_dep_type_from_path(deps$path) + class(deps) <- c("pkg_scan_deps", class(deps)) deps } @@ -331,6 +332,7 @@ scan_pat_deps_do_db_hits <- function(hits, path) { ) } +# nocov start prot_xfun_pkg_attach <- function(..., install, message) { } prot_xfun_pkg_attach2 <- function(...) { } prot_pacman_p_load <- function( @@ -366,6 +368,7 @@ prot_testthat_test_dir <- function( path, filter = NULL, reporter = NULL, ...) { } prot_testthat_test_file <- function(path, reporter = NULL, ...) { } +# nocov end safe_parse_pkg_from_call <- function(ns, fn, code) { tryCatch( @@ -374,7 +377,7 @@ safe_parse_pkg_from_call <- function(ns, fn, code) { ) } -parse_pkg_from_call <- function(ns, fn, code) { +parse_pkg_from_call_match <- function(fn, code) { expr <- parse(text = code, keep.source = FALSE) fun <- switch(fn, "library" = base::library, @@ -399,13 +402,17 @@ parse_pkg_from_call <- function(ns, fn, code) { "test_dir" = prot_testthat_test_dir, "test_file" = prot_testthat_test_file ) - matched <- match.call(fun, expr, expand.dots = FALSE) + match.call(fun, expr, expand.dots = FALSE) +} + +parse_pkg_from_call <- function(ns, fn, code) { + matched <- parse_pkg_from_call_match(fn, code) switch(fn, "library" = , "require" = - parse_pkg_from_call_library(ns, fs, matched), + parse_pkg_from_call_library(ns, fn, matched), "loadNamespace" = , "requireNamespace" = - parse_pkg_from_call_loadNamespace(ns, fn, matched), - "pkg_attache" = , "pkg_attach2" = + parse_pkg_from_call_loadnamespace(ns, fn, matched), + "pkg_attach" = , "pkg_attach2" = parse_pkg_from_call_xfun(ns, fn, matched), "p_load" = parse_pkg_from_call_pacman(ns, fn, matched), @@ -445,7 +452,7 @@ parse_pkg_from_call_library <- function(ns, fn, matched) { NULL } -parse_pkg_from_call_loadNamespace <- function(ns, fn, matched) { +parse_pkg_from_call_loadnamespace <- function(ns, fn, matched) { if (!is.na(ns) && ns != "base") return(NULL) pkg <- matched[["package"]] if (is.character(pkg) && length(pkg) == 1) { @@ -471,7 +478,7 @@ parse_pkg_from_call_pacman <- function(ns, fn, matched) { # character vector or scalar char <- matched[["char"]] - if (char[[1]] == quote(c)) { + if (length(char) > 0 && char[[1]] == quote(c)) { pkgs <- c(pkgs, as.list(char[-1])) } else if (is.character(char)) { pkgs <- c(pkgs, as.list(char)) diff --git a/src/tree-sitter/markdown-inline/parser.c b/src/tree-sitter/markdown-inline/parser.c index 534df523..6432ea6b 100644 --- a/src/tree-sitter/markdown-inline/parser.c +++ b/src/tree-sitter/markdown-inline/parser.c @@ -1,7 +1,7 @@ #include "tree_sitter/parser.h" #if defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic ignored "-Wmissing-field-initializers" +# pragma GCC diagnostic ignored "-Wmissing-field-initializers" #endif #ifdef _MSC_VER diff --git a/src/tree-sitter/markdown-inline/tree_sitter/array.h b/src/tree-sitter/markdown-inline/tree_sitter/array.h index 15a3b233..4f4306f7 100644 --- a/src/tree-sitter/markdown-inline/tree_sitter/array.h +++ b/src/tree-sitter/markdown-inline/tree_sitter/array.h @@ -16,8 +16,8 @@ extern "C" { #ifdef _MSC_VER #pragma warning(disable : 4101) #elif defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic push -#pragma GCC diagnostic ignored "-Wunused-variable" +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Wunused-variable" #endif #define Array(T) \ @@ -280,7 +280,7 @@ static inline void _array__splice(Array *self, size_t element_size, #ifdef _MSC_VER #pragma warning(default : 4101) #elif defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic pop +# pragma GCC diagnostic pop #endif #ifdef __cplusplus diff --git a/src/tree-sitter/markdown/parser.c b/src/tree-sitter/markdown/parser.c index 29fa9749..e698fdfb 100644 --- a/src/tree-sitter/markdown/parser.c +++ b/src/tree-sitter/markdown/parser.c @@ -1,7 +1,7 @@ #include "tree_sitter/parser.h" #if defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic ignored "-Wmissing-field-initializers" +# pragma GCC diagnostic ignored "-Wmissing-field-initializers" #endif #ifdef _MSC_VER diff --git a/src/tree-sitter/markdown/tree_sitter/array.h b/src/tree-sitter/markdown/tree_sitter/array.h index 15a3b233..4f4306f7 100644 --- a/src/tree-sitter/markdown/tree_sitter/array.h +++ b/src/tree-sitter/markdown/tree_sitter/array.h @@ -16,8 +16,8 @@ extern "C" { #ifdef _MSC_VER #pragma warning(disable : 4101) #elif defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic push -#pragma GCC diagnostic ignored "-Wunused-variable" +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Wunused-variable" #endif #define Array(T) \ @@ -280,7 +280,7 @@ static inline void _array__splice(Array *self, size_t element_size, #ifdef _MSC_VER #pragma warning(default : 4101) #elif defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic pop +# pragma GCC diagnostic pop #endif #ifdef __cplusplus diff --git a/src/tree-sitter/r/parser.c b/src/tree-sitter/r/parser.c index 34a47d4e..f3d9000c 100644 --- a/src/tree-sitter/r/parser.c +++ b/src/tree-sitter/r/parser.c @@ -1,7 +1,7 @@ #include "tree_sitter/parser.h" #if defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic ignored "-Wmissing-field-initializers" +# pragma GCC diagnostic ignored "-Wmissing-field-initializers" #endif #define LANGUAGE_VERSION 14 diff --git a/src/tree-sitter/r/tree_sitter/array.h b/src/tree-sitter/r/tree_sitter/array.h index 15a3b233..4f4306f7 100644 --- a/src/tree-sitter/r/tree_sitter/array.h +++ b/src/tree-sitter/r/tree_sitter/array.h @@ -16,8 +16,8 @@ extern "C" { #ifdef _MSC_VER #pragma warning(disable : 4101) #elif defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic push -#pragma GCC diagnostic ignored "-Wunused-variable" +# pragma GCC diagnostic push +# pragma GCC diagnostic ignored "-Wunused-variable" #endif #define Array(T) \ @@ -280,7 +280,7 @@ static inline void _array__splice(Array *self, size_t element_size, #ifdef _MSC_VER #pragma warning(default : 4101) #elif defined(__GNUC__) || defined(__clang__) -#pragma GCC diagnostic pop +# pragma GCC diagnostic pop #endif #ifdef __cplusplus diff --git a/tests/testthat/_snaps/scan-deps-dep-types.md b/tests/testthat/_snaps/scan-deps-dep-types.md new file mode 100644 index 00000000..5eb8d999 --- /dev/null +++ b/tests/testthat/_snaps/scan-deps-dep-types.md @@ -0,0 +1,8 @@ +# get_dep_type_from_path + + Code + get_dep_type_from_path(c("R/foo.R", "man/roxygen/meta.R", "tests/test-1.R", + "test/test-2.R")) + Output + [1] "prod" "dev" "test" "test" + diff --git a/tests/testthat/_snaps/scan-deps-queries.md b/tests/testthat/_snaps/scan-deps-queries.md index 401708f2..a626c45f 100644 --- a/tests/testthat/_snaps/scan-deps-queries.md +++ b/tests/testthat/_snaps/scan-deps-queries.md @@ -43,3 +43,248 @@ 3 2 1 2 14 25 1 14 1 26 dep-code require(bar) 4 1 1 2 14 20 1 14 1 21 fn-name require +# q_module_import + + Code + do("fixtures/scan/modules.R") + Output + # A data frame: 18 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 2 1 1 11 21 2 2 2 13 dep-code "import(\"A\")" + 2 1 1 1 11 16 2 2 2 8 fn-name "import" + 3 2 1 2 24 32 3 2 3 11 dep-code "import(B)" + 4 1 1 2 24 29 3 2 3 8 fn-name "import" + 5 2 1 3 35 52 4 2 4 20 dep-code "import(from = \"C\")" + 6 1 1 3 35 40 4 2 4 8 fn-name "import" + 7 2 1 4 55 78 5 2 5 26 dep-code "import(symbol, from = D)" + 8 1 1 4 55 60 5 2 5 8 fn-name "import" + 9 2 1 5 163 173 10 1 10 12 dep-code "import(\"e\")" + 10 1 1 5 163 168 10 1 10 7 fn-name "import" + 11 2 1 6 175 183 11 1 11 10 dep-code "import(f)" + 12 1 1 6 175 180 11 1 11 7 fn-name "import" + 13 2 2 7 263 282 15 1 15 21 dep-code "modules::import(\"G\")" + 14 3 2 7 263 269 15 1 15 8 ns-name "modules" + 15 1 2 7 272 277 15 10 15 16 fn-name "import" + 16 2 2 8 284 301 16 1 16 19 dep-code "modules::import(H)" + 17 3 2 8 284 290 16 1 16 8 ns-name "modules" + 18 1 2 8 293 298 16 10 16 16 fn-name "import" + Code + do("fixtures/scan/modules-empty.R") + Output + # A data frame: 0 x 11 + # i 11 variables: id , pattern , match , start_byte , end_byte , start_row , start_column , end_row , end_column , name , code + +# q_colon + + Code + do("x <- foo::bar()") + Output + # A data frame: 2 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 2 1 1 6 13 1 6 1 14 dep-code foo::bar + 2 1 1 1 6 8 1 6 1 9 pkg-name foo + Code + do("1 + 2 + foo:::bar") + Output + # A data frame: 2 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 2 1 1 9 17 1 9 1 18 dep-code foo:::bar + 2 1 1 1 9 11 1 9 1 12 pkg-name foo + +# q_methods + + Code + do("setClass('myclass')") + Output + # A data frame: 2 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 2 1 1 1 19 1 1 1 20 dep-code setClass('myclass') + 2 1 1 1 1 8 1 1 1 9 fn-name setClass + Code + do("setGeneric('props', function(object) attributes(object))") + Output + # A data frame: 2 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 2 1 1 1 56 1 1 1 57 dep-code setGeneric('props', function(object) attributes(object)) + 2 1 1 1 1 10 1 1 1 11 fn-name setGeneric + +# q_junit_reporter + + Code + do("JunitReporter$new()") + Output + # A data frame: 3 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 3 1 1 1 19 1 1 1 20 dep-code JunitReporter$new() + 2 1 1 1 1 13 1 1 1 14 class-name JunitReporter + 3 2 1 1 15 17 1 15 1 18 method-name new + Code + do("testthat::JunitReporter$new()") + Output + # A data frame: 4 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 3 2 1 1 29 1 1 1 30 dep-code testthat::JunitReporter$new() + 2 4 2 1 1 8 1 1 1 9 pkg-name testthat + 3 1 2 1 11 23 1 11 1 24 class-name JunitReporter + 4 2 2 1 25 27 1 25 1 28 method-name new + +# q_knitr_dev + + Code + do("opts_chunk$set()") + Output + # A data frame: 3 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 3 1 1 1 16 1 1 1 17 dep-code opts_chunk$set() + 2 1 1 1 1 10 1 1 1 11 object-name opts_chunk + 3 2 1 1 12 14 1 12 1 15 method-name set + Code + do("knitr::opts_chunk$set()") + Output + # A data frame: 4 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 3 2 1 1 23 1 1 1 24 dep-code knitr::opts_chunk$set() + 2 4 2 1 1 5 1 1 1 6 pkg-name knitr + 3 1 2 1 8 17 1 8 1 18 object-name opts_chunk + 4 2 2 1 19 21 1 19 1 22 method-name set + +# renv_dependencies_database + + Code + renv_dependencies_database() + Output + $ggplot2 + $ggplot2$geom_hex + [1] "hexbin" + + + $testthat + $testthat$JunitReporter + [1] "xml2" + + + +# q_database + + Code + do("geom_hex()") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 1 8 1 1 1 9 id geom_hex + Code + do("ggplot2::geom_hex()") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 10 17 1 10 1 18 id geom_hex + Code + do("JunitReporter") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 1 13 1 1 1 14 id JunitReporter + Code + do("testthat::JunitReporter") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 11 23 1 11 1 24 id JunitReporter + +# q_database #3 + + Code + do("geom_hex()") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 1 8 1 1 1 9 id geom_hex + Code + do("foopkg::foofun()") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 9 14 1 9 1 15 id foofun + Code + do("foofun") + Output + # A data frame: 1 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 1 1 1 1 6 1 1 1 7 id foofun + +# q_deps + + Code + q_deps() + Output + [1] 1 2 3 4 5 6 + +# q_deps_rmd + + Code + code_query(readLines(test_path("fixtures/scan/chunk-errors.Rmd")), query = q_deps_rmd(), language = "markdown")[["matched_captures"]] + Output + # A data frame: 14 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 4 2 1 5 16 2 4 2 16 inline "Parse Errors" + 2 4 2 2 19 105 4 1 5 14 inline "renv should still be able to recover dependencies from the chunks without\nparse errors." + 3 2 1 3 111 113 7 4 7 7 header "{r}" + 4 1 1 3 112 112 7 5 7 6 language "r" + 5 3 1 3 115 129 8 1 9 1 content "library(dplyr)\n" + 6 2 1 4 138 140 11 4 11 7 header "{r}" + 7 1 1 4 139 139 11 5 11 6 language "r" + 8 3 1 4 142 169 12 1 13 1 content "this chunk has parse errors\n" + 9 2 1 5 178 180 15 4 15 7 header "{r}" + 10 1 1 5 179 179 15 5 15 6 language "r" + 11 3 1 5 182 204 16 1 17 1 content "and so does this chunk\n" + 12 2 1 6 213 215 19 4 19 7 header "{r}" + 13 1 1 6 214 214 19 5 19 6 language "r" + 14 3 1 6 217 245 20 1 20 30 content "we forgot to close this chunk" + +--- + + Code + code_query(readLines(test_path("fixtures/scan/inline-chunks.Rmd")), query = q_deps_rmd(), language = "markdown")[["matched_captures"]] + Output + # A data frame: 3 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 4 2 1 5 17 2 4 2 17 inline Inline Chunks + 2 4 2 2 20 146 4 1 4 128 inline Users might request the use of packages with `r inline::chunks()`. Check that we handle `r multiple::calls()` on the same line. + 3 4 2 3 149 179 6 1 6 32 inline Also in `r separate::chunks()`. + +# q_deps_rmd_inline + + Code + code_query(readLines(test_path("fixtures/scan/inline-chunks.Rmd")), query = q_deps_rmd_inline(), language = "markdown-inline", ranges = code[, range_cols])[["matched_captures"]] + Output + # A data frame: 9 x 11 + id pattern match start_byte end_byte start_row start_column end_row end_column name code + + 1 3 1 1 65 84 4 46 4 66 code `r inline::chunks()` + 2 1 1 1 65 65 4 46 4 47 csd1 ` + 3 2 1 1 84 84 4 65 4 66 csd2 ` + 4 3 1 2 108 128 4 89 4 110 code `r multiple::calls()` + 5 1 1 2 108 108 4 89 4 90 csd1 ` + 6 2 1 2 128 128 4 109 4 110 csd2 ` + 7 3 1 3 157 178 6 9 6 31 code `r separate::chunks()` + 8 1 1 3 157 157 6 9 6 10 csd1 ` + 9 2 1 3 178 178 6 30 6 31 csd2 ` + diff --git a/tests/testthat/_snaps/scan-deps.md b/tests/testthat/_snaps/scan-deps.md new file mode 100644 index 00000000..c6e891af --- /dev/null +++ b/tests/testthat/_snaps/scan-deps.md @@ -0,0 +1,273 @@ +# get_deps_cache_path + + Code + writeLines(get_deps_cache_path()) + Output + //R/pkgcache/deps/1 + Code + writeLines(get_deps_cache_path("badcafe")) + Output + //R/pkgcache/deps/1/ba/badcafe + +# clear_deps_cache + + Code + dir(tmp, recursive = TRUE) + Output + [1] "R/pkgcache/deps/1/ba/badcafe" + +--- + + Code + dir(tmp, recursive = TRUE) + Output + character(0) + +# re_r_dep + + Code + re_r_dep() + Output + [1] "library|require|loadNamespace|::|setClass|setGeneric|pkg_attach|p_load|module|import|box::|tar_option_set|glue|ggsave|set_engine|opts_chunk|geom_hex|JunitReporter|geom_hex|JunitReporter" + +# scan_path_deps_empty + + Code + scan_path_deps_empty() + Output + # A data frame: 0 x 7 + # i 7 variables: path , package , type , code , + # start_row , start_column , start_byte + +# scan_path_deps_do + + Code + scan_path_deps_do(readLines(rfile), basename(rfile)) + Output + # A data frame: 3 x 7 + path package type code start_row start_column start_byte + + 1 code.R CD prod CD::pkg 4 1 26 + 2 code.R AB prod library(AB) 1 1 1 + 3 code.R BC prod require(BC) 2 1 13 + +--- + + Code + scan_path_deps_do("code", "foo.unknown") + Condition + Error: + ! Cannot parse .unknown file for dependencies, internal error + +# scan_path_deps_do_r + + Code + scan_path_deps_do_r(readLines(rfile), rfile) + Output + # A data frame: 3 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/project-1/R/code.R CD prod CD::pkg 4 1 26 + 2 fixtures/scan/project-1/R/code.R AB prod library(AB) 1 1 1 + 3 fixtures/scan/project-1/R/code.R BC prod require(BC) 2 1 13 + +# scan_path_deps_do_fn_hits + + Code + scan_path_deps_do_r(readLines(rfile), rfile) + Output + # A data frame: 2 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/methods.R methods prod "setClass(\"track\", slots = c(x=\"numeric\", y=\"numeric\"))" 2 10 43 + 2 fixtures/scan/methods.R methods prod "setGeneric(\"plot\")" 6 1 171 + +# scan_path_deps_do_jr_hits + + Code + scan_path_deps_do_r(readLines(rfile), rfile) + Output + # A data frame: 6 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/junit.R testthat prod testthat::JunitReporter 1 8 8 + 2 fixtures/scan/junit.R testthat prod library(testthat) 3 1 39 + 3 fixtures/scan/junit.R xml2 prod testthat::JunitReporter$new() 1 8 8 + 4 fixtures/scan/junit.R xml2 prod JunitReporter$new() 5 9 66 + 5 fixtures/scan/junit.R xml2 prod JunitReporter 1 18 18 + 6 fixtures/scan/junit.R xml2 prod JunitReporter 5 9 66 + +# scan_pat_deps_do_ragg_hits + + Code + scan_path_deps_do_rmd(readLines(rfile), rfile) + Output + # A data frame: 3 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/knitr.Rmd knitr prod "knitr::opts_chunk" 3 1 9 + 2 fixtures/scan/knitr.Rmd knitr prod "knitr::opts_chunk" 7 1 61 + 3 fixtures/scan/knitr.Rmd ragg prod "knitr::opts_chunk$set(dev = \"ragg_png\")" 3 1 9 + +--- + + Code + scan_path_deps_do_rmd(readLines(rfile), rfile) + Output + # A data frame: 1 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/noragg.Rmd knitr prod knitr::opts_chunk 2 1 8 + +# safe_parse_pkg_from_call + + Code + safe_parse_pkg_from_call(NA_character_, "library", "library(qwe)") + Output + [1] "qwe" + +# parse_pkg_from_call + + Code + parse_pkg_from_call(NA_character_, "library", "library(qwe)") + Output + [1] "qwe" + Code + parse_pkg_from_call("base", "loadNamespace", "loadNamespace('q1')") + Output + [1] "q1" + Code + parse_pkg_from_call("base", "requireNamespace", "requireNamespace('q1')") + Output + [1] "q1" + Code + parse_pkg_from_call(NA_character_, "pkg_attach", "pkg_attach('foobar')") + Output + [1] "foobar" + Code + parse_pkg_from_call(NA_character_, "pkg_attach2", "pkg_attach2('foobar')") + Output + [1] "foobar" + Code + parse_pkg_from_call("pacman", "p_load", "p_load('p1')") + Output + [1] "p1" + Code + parse_pkg_from_call(NA_character_, "import", "import(x1)") + Output + [1] "x1" + Code + parse_pkg_from_call(NA_character_, "module", "module({import('x2')})") + Output + [1] "x2" + Code + parse_pkg_from_call("import", "from", "import::from(dplyr)") + Output + [1] "dplyr" + Code + parse_pkg_from_call("import", "into", + "import::into('operators', .from = 'dplyr')") + Output + [1] "dplyr" + Code + parse_pkg_from_call("import", "here", "import::here('dplyr')") + Output + [1] "dplyr" + Code + parse_pkg_from_call("box", "use", "box::use(dplyr[filter, select])") + Output + [1] "dplyr" + Code + parse_pkg_from_call("targets", "tar_option_set", + "tar_option_set(packages = c('p1', 'p2'))") + Output + [1] "p1" "p2" + Code + parse_pkg_from_call("glue", "glue", "glue::glue('blah {library(x5)} blah')") + Output + [1] "x5" + Code + parse_pkg_from_call(NA_character_, "ggsave", "ggsave(filename = 'foo.svg')") + Output + [1] "svglite" + Code + parse_pkg_from_call(NA_character_, "set_engine", "set_engine(engine = 'spark')") + Output + [1] "sparklyr" + Code + parse_pkg_from_call("R6", "R6Class", + "R6::R6Class('foobar', inherit = JunitReporter)") + Output + [1] "xml2" + Code + parse_pkg_from_call("testthat", "test_dir", + "testthat::test_dir(reporter = 'junit')") + Output + [1] "xml2" + +# parse_pkg_from_call_library + + Code + ppcl("library", "library(qqq)") + Output + [1] "qqq" + Code + ppcl("library", "library('qqq')") + Output + [1] "qqq" + Code + ppcl("library", "library(qqq)", ns = "base") + Output + [1] "qqq" + Code + ppcl("require", "require(qqq)") + Output + [1] "qqq" + Code + ppcl("require", "require('qqq')") + Output + [1] "qqq" + Code + ppcl("require", "require('qqq')", ns = "base") + Output + [1] "qqq" + +# dependencies_eval + + Code + dependencies_eval(quote({ + 1:10 + c(10:1)[1:3] + })) + Output + [1] 10 9 8 + +# scan_path_deps_do_rmd + + Code + scan_path_deps_do_rmd(readLines(path), "chunk-errors.Rmd") + Output + # A data frame: 1 x 7 + path package type code start_row start_column start_byte + + 1 chunk-errors.Rmd dplyr prod library(dplyr) 8 1 115 + +# scan_path_deps_do_rmd #2 + + Code + scan_path_deps_do_rmd(readLines(path), "inline-chunks.Rmd") + Output + # A data frame: 3 x 7 + path package type code start_row start_column start_byte + + 1 inline-chunks.Rmd inline prod inline::chunks 4 49 68 + 2 inline-chunks.Rmd multiple prod multiple::calls 4 92 111 + 3 inline-chunks.Rmd separate prod separate::chunks 6 12 160 + +# scan_path_deps_do_rmd #3 + + Code + scan_path_deps_do_rmd(readLines(path), "nothing.Rmd") + Output + NULL + diff --git a/tests/testthat/_snaps/unix/scan-deps.md b/tests/testthat/_snaps/unix/scan-deps.md new file mode 100644 index 00000000..cf2f3ed5 --- /dev/null +++ b/tests/testthat/_snaps/unix/scan-deps.md @@ -0,0 +1,53 @@ +# scan_deps + + Code + scan_deps(project)[] + Output + # A data frame: 6 x 7 + path package type code start_row start_column start_byte + + 1 R/code.R CD prod CD::pkg 4 1 26 + 2 R/code.R AB prod library(AB) 1 1 1 + 3 R/code.R BC prod require(BC) 2 1 13 + 4 doc.qmd pkgload prod pkgload::load_all 12 1 174 + 5 index.Rmd ST prod ST::fun 10 1 97 + 6 index.Rmd RS prod library(RS) 9 1 85 + +--- + + Code + scan_deps(project) + Output + + Dependencies: + + AB @ R/code.R + + BC @ R/code.R + + CD @ R/code.R + + RS @ index.Rmd + + ST @ index.Rmd + + pkgload @ doc.qmd + +# scan_path_deps + + Code + scan_path_deps(rfile) + Output + # A data frame: 3 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/project-1/R/code.R CD prod CD::pkg 4 1 26 + 2 fixtures/scan/project-1/R/code.R AB prod library(AB) 1 1 1 + 3 fixtures/scan/project-1/R/code.R BC prod require(BC) 2 1 13 + +--- + + Code + scan_path_deps(rfile) + Output + # A data frame: 3 x 7 + path package type code start_row start_column start_byte + + 1 fixtures/scan/project-1/R/code.R CD prod CD::pkg 4 1 26 + 2 fixtures/scan/project-1/R/code.R AB prod library(AB) 1 1 1 + 3 fixtures/scan/project-1/R/code.R BC prod require(BC) 2 1 13 + diff --git a/tests/testthat/fixtures/scan/chunk-errors.Rmd b/tests/testthat/fixtures/scan/chunk-errors.Rmd new file mode 100644 index 00000000..26065b95 --- /dev/null +++ b/tests/testthat/fixtures/scan/chunk-errors.Rmd @@ -0,0 +1,20 @@ + +## Parse Errors + +renv should still be able to recover dependencies from the chunks without +parse errors. + +```{r} +library(dplyr) +``` + +```{r} +this chunk has parse errors +``` + +```{r} +and so does this chunk +``` + +```{r} +we forgot to close this chunk diff --git a/tests/testthat/fixtures/scan/inline-chunks.Rmd b/tests/testthat/fixtures/scan/inline-chunks.Rmd new file mode 100644 index 00000000..deed427a --- /dev/null +++ b/tests/testthat/fixtures/scan/inline-chunks.Rmd @@ -0,0 +1,6 @@ + +## Inline Chunks + +Users might request the use of packages with `r inline::chunks()`. Check that we handle `r multiple::calls()` on the same line. + +Also in `r separate::chunks()`. diff --git a/tests/testthat/fixtures/scan/junit.R b/tests/testthat/fixtures/scan/junit.R new file mode 100644 index 00000000..bdb42284 --- /dev/null +++ b/tests/testthat/fixtures/scan/junit.R @@ -0,0 +1,5 @@ +rep <- testthat::JunitReporter$new() + +library(testthat) + +rep2 <- JunitReporter$new() diff --git a/tests/testthat/fixtures/scan/knitr.Rmd b/tests/testthat/fixtures/scan/knitr.Rmd new file mode 100644 index 00000000..514894f6 --- /dev/null +++ b/tests/testthat/fixtures/scan/knitr.Rmd @@ -0,0 +1,8 @@ + +```{r} +knitr::opts_chunk$set(dev = "ragg_png") +``` + +```{r} +knitr::opts_chunk$set() +``` diff --git a/tests/testthat/fixtures/scan/methods.R b/tests/testthat/fixtures/scan/methods.R new file mode 100644 index 00000000..6ba7e67c --- /dev/null +++ b/tests/testthat/fixtures/scan/methods.R @@ -0,0 +1,10 @@ +## A simple class with two slots +track <- setClass("track", slots = c(x="numeric", y="numeric")) +## an object from the class +t1 <- track(x = 1:10, y = 1:10 + rnorm(10)) + +setGeneric("plot") + +setMethod("plot", signature(x="track", y="missing"), +function(x, y, ...) plot(x@x, x@y, ...) +) diff --git a/tests/testthat/fixtures/scan/modules-empty.R b/tests/testthat/fixtures/scan/modules-empty.R new file mode 100644 index 00000000..1c0ba96f --- /dev/null +++ b/tests/testthat/fixtures/scan/modules-empty.R @@ -0,0 +1,4 @@ + +example <- function() { + module() +} diff --git a/tests/testthat/fixtures/scan/modules.R b/tests/testthat/fixtures/scan/modules.R new file mode 100644 index 00000000..65337c5b --- /dev/null +++ b/tests/testthat/fixtures/scan/modules.R @@ -0,0 +1,17 @@ +module({ + import("A") + import(B) + import(from = "C") + import(symbol, from = D) +}) + +# NOTE: these should be ignored as they are not +# called within a module block +import("e") +import(f) + +# NOTE: fully scoped modules::import calls should +# be added to dependencies +modules::import("G") +modules::import(H) + diff --git a/tests/testthat/fixtures/scan/noragg.Rmd b/tests/testthat/fixtures/scan/noragg.Rmd new file mode 100644 index 00000000..b60a3a67 --- /dev/null +++ b/tests/testthat/fixtures/scan/noragg.Rmd @@ -0,0 +1,3 @@ +```{r} +knitr::opts_chunk$set() +``` diff --git a/tests/testthat/fixtures/scan/nothing.Rmd b/tests/testthat/fixtures/scan/nothing.Rmd new file mode 100644 index 00000000..320df755 --- /dev/null +++ b/tests/testthat/fixtures/scan/nothing.Rmd @@ -0,0 +1,10 @@ +No dependencies here at all `foo library + not + r`. + +```{bar} +another language +``` + +```{r} +# R, but no dependencies +just + normal + code +``` diff --git a/tests/testthat/fixtures/scan/project-1/DESCRIPTION b/tests/testthat/fixtures/scan/project-1/DESCRIPTION new file mode 100644 index 00000000..dfc231b3 --- /dev/null +++ b/tests/testthat/fixtures/scan/project-1/DESCRIPTION @@ -0,0 +1 @@ +Package: pkgdependstest diff --git a/tests/testthat/fixtures/scan/project-1/R/code.R b/tests/testthat/fixtures/scan/project-1/R/code.R new file mode 100644 index 00000000..8687e53d --- /dev/null +++ b/tests/testthat/fixtures/scan/project-1/R/code.R @@ -0,0 +1,4 @@ +library(AB) +require(BC) + +CD::pkg() diff --git a/tests/testthat/fixtures/scan/project-1/doc.qmd b/tests/testthat/fixtures/scan/project-1/doc.qmd new file mode 100644 index 00000000..b312e088 --- /dev/null +++ b/tests/testthat/fixtures/scan/project-1/doc.qmd @@ -0,0 +1,13 @@ +--- +project: + type: website + resources: + - "manifest.json" +execute: + cache: false +title: Docker containers for R developers +--- + +```{r include = FALSE, cache = FALSE} +pkgload::load_all() +``` diff --git a/tests/testthat/fixtures/scan/project-1/index.Rmd b/tests/testthat/fixtures/scan/project-1/index.Rmd new file mode 100644 index 00000000..87205409 --- /dev/null +++ b/tests/testthat/fixtures/scan/project-1/index.Rmd @@ -0,0 +1,11 @@ +--- +title: pkgdepends +output: + github_document: +always_allow_html: yes +--- + +```{r} +library(RS) +ST::fun() +``` diff --git a/tests/testthat/helper-apps.R b/tests/testthat/helper-apps.R index c38906a3..f00dfc33 100644 --- a/tests/testthat/helper-apps.R +++ b/tests/testthat/helper-apps.R @@ -606,11 +606,16 @@ transform_etag <- function(x) { } transform_tempdir <- function(x) { - x <- sub(tempdir(), "", x) - x <- sub(normalizePath(tempdir()), "", x) - x <- sub(normalizePath(tempdir(), winslash = "/"), "", x) + x <- sub(tempdir(), "", x, fixed = TRUE) + x <- sub(normalizePath(tempdir()), "", x, fixed = TRUE) + x <- sub( + normalizePath(tempdir(), winslash = "/"), + "", x, + fixed = TRUE + ) + x <- sub("\\R\\", "/R/", x, fixed = TRUE) x <- sub("[\\\\/]file[a-zA-Z0-9]+", "/", x) - x <- sub("[A-Z]:.*Rtmp[a-zA-Z0-9]+/", "/", x) + x <- sub("[A-Z]:.*Rtmp[a-zA-Z0-9]+[\\\\/]", "/", x) x } diff --git a/tests/testthat/helper-mock.R b/tests/testthat/helper-mock.R new file mode 100644 index 00000000..0e90b9db --- /dev/null +++ b/tests/testthat/helper-mock.R @@ -0,0 +1,110 @@ +fake <- local({ + fake_through_tree <- function(tree, what, how) { + for (d in tree) { + for (parent in d) { + parent_env <- parent[["parent_env"]] + func_dict <- parent[["funcs"]] + for (func_name in ls(func_dict, all.names = TRUE)) { + func <- func_dict[[func_name]] + func_env <- new.env(parent = environment(func)) + + what <- override_seperators(what, func_env) + where_name <- override_seperators(func_name, parent_env) + + if (!is.function(how)) { + assign(what, function(...) how, func_env) + } else { + assign(what, how, func_env) + } + + environment(func) <- func_env + locked <- exists(where_name, parent_env, inherits = FALSE) && + bindingIsLocked(where_name, parent_env) + if (locked) { + baseenv()$unlockBinding(where_name, parent_env) + } + assign(where_name, func, parent_env) + if (locked) { + lockBinding(where_name, parent_env) + } + } + } + } + } + + override_seperators <- function(name, env) { + mangled_name <- NULL + for (sep in c("::", "$")) { + if (grepl(sep, name, fixed = TRUE)) { + elements <- strsplit(name, sep, fixed = TRUE) + mangled_name <- paste( + elements[[1L]][1L], + elements[[1L]][2L], + sep = "XXX" + ) + + stub_list <- c(mangled_name) + if ("stub_list" %in% names(attributes(get(sep, env)))) { + stub_list <- c(stub_list, attributes(get(sep, env))[["stub_list"]]) + } + + create_new_name <- create_create_new_name_function( + stub_list, + env, + sep + ) + assign(sep, create_new_name, env) + } + } + mangled_name %||% name + } + + backtick <- function(x) { + encodeString(x, quote = "`", na.encode = FALSE) + } + + create_create_new_name_function <- function(stub_list, env, sep) { + force(stub_list) + force(env) + force(sep) + + create_new_name <- function(pkg, func) { + pkg_name <- deparse(substitute(pkg)) + func_name <- deparse(substitute(func)) + for (stub in stub_list) { + if (paste(pkg_name, func_name, sep = "XXX") == stub) { + return(eval(parse(text = backtick(stub)), env)) + } + } + + # used to avoid recursively calling the replacement function + eval_env <- new.env(parent = parent.frame()) + assign(sep, eval(parse(text = paste0("`", sep, "`"))), eval_env) + + code <- paste(pkg_name, backtick(func_name), sep = sep) + return(eval(parse(text = code), eval_env)) + } + attributes(create_new_name) <- list(stub_list = stub_list) + create_new_name + } + + build_function_tree <- function(test_env, where, where_name) { + func_dict <- new.env() + func_dict[[where_name]] <- where + tree <- list( + list( + list(parent_env = test_env, funcs = func_dict) + ) + ) + + tree + } + + fake <- function(where, what, how) { + where_name <- deparse(substitute(where)) + stopifnot(is.character(what), length(what) == 1) + test_env <- parent.frame() + tree <- build_function_tree(test_env, where, where_name) + fake_through_tree(tree, what, how) + } +}) diff --git a/tests/testthat/test-scan-deps-dep-types.R b/tests/testthat/test-scan-deps-dep-types.R new file mode 100644 index 00000000..d3e9bf1e --- /dev/null +++ b/tests/testthat/test-scan-deps-dep-types.R @@ -0,0 +1,10 @@ +test_that("get_dep_type_from_path", { + expect_snapshot({ + get_dep_type_from_path(c( + "R/foo.R", + "man/roxygen/meta.R", + "tests/test-1.R", + "test/test-2.R" + )) + }) +}) diff --git a/tests/testthat/test-scan-deps-queries.R b/tests/testthat/test-scan-deps-queries.R index def0f179..eb5326c2 100644 --- a/tests/testthat/test-scan-deps-queries.R +++ b/tests/testthat/test-scan-deps-queries.R @@ -11,3 +11,149 @@ test_that("q_library_0", { do("library(foo, require(bar))") }) }) + +test_that("q_module_import", { + local_reproducible_output(width = 500) + do <- function(path) { + apath <- test_path(path) + code_query(readLines(apath), q_module_import())[["matched_captures"]] + } + expect_snapshot({ + do("fixtures/scan/modules.R") + do("fixtures/scan/modules-empty.R") + }) +}) + +test_that("q_colon", { + local_reproducible_output(width = 500) + do <- function(code) { + code_query(code, q_colon())[["matched_captures"]] + } + expect_snapshot({ + do("x <- foo::bar()") + do("1 + 2 + foo:::bar") + }) +}) + +test_that("q_methods", { + local_reproducible_output(width = 500) + do <- function(code) { + code_query(code, q_methods())[["matched_captures"]] + } + expect_snapshot({ + do("setClass('myclass')") + do("setGeneric('props', function(object) attributes(object))") + }) +}) + +test_that("q_junit_reporter", { + local_reproducible_output(width = 500) + do <- function(code) { + code_query(code, q_junit_reporter())[["matched_captures"]] + } + expect_snapshot({ + do("JunitReporter$new()") + do("testthat::JunitReporter$new()") + }) +}) + +test_that("q_knitr_dev", { + local_reproducible_output(width = 500) + do <- function(code) { + code_query(code, q_knitr_dev())[["matched_captures"]] + } + expect_snapshot({ + do("opts_chunk$set()") + do("knitr::opts_chunk$set()") + }) +}) + +test_that("renv_dependencies_database", { + expect_snapshot({ + renv_dependencies_database() + }) +}) + +test_that("q_database", { + local_reproducible_output(width = 500) + do <- function(code) { + code_query(code, q_database())[["matched_captures"]] + } + expect_snapshot({ + do("geom_hex()") + do("ggplot2::geom_hex()") + do("JunitReporter") + do("testthat::JunitReporter") + }) +}) + +test_that("q_database #2", { + fake(q_database, "renv_dependencies_database", NULL) + expect_null(q_database()) +}) + +test_that("q_database #3", { + local_reproducible_output(width = 500) + withr::local_options(renv.dependencies.database = + list(foopkg = list(foofun = "foodep")) + ) + do <- function(code) { + code_query(code, q_database())[["matched_captures"]] + } + expect_snapshot({ + do("geom_hex()") + do("foopkg::foofun()") + do("foofun") + }) +}) + +test_that("q_deps", { + fake(q_deps, "q_library_0", 1) + fake(q_deps, "q_colon", 2) + fake(q_deps, "q_methods", 3) + fake(q_deps, "q_junit_reporter", 4) + fake(q_deps, "q_knitr_dev", 5) + fake(q_deps, "q_database", 6) + expect_snapshot( + q_deps() + ) +}) + +test_that("q_deps_rmd", { + local_reproducible_output(width = 500) + + expect_snapshot({ + code_query( + readLines(test_path("fixtures/scan/chunk-errors.Rmd")), + query = q_deps_rmd(), + language = "markdown" + )[["matched_captures"]] + }) + + expect_snapshot({ + code_query( + readLines(test_path("fixtures/scan/inline-chunks.Rmd")), + query = q_deps_rmd(), + language = "markdown" + )[["matched_captures"]] + }) +}) + +test_that("q_deps_rmd_inline", { + local_reproducible_output(width = 500) + + code <- code_query( + readLines(test_path("fixtures/scan/inline-chunks.Rmd")), + query = q_deps_rmd(), + language = "markdown" + )[["matched_captures"]] + + expect_snapshot({ + code_query( + readLines(test_path("fixtures/scan/inline-chunks.Rmd")), + query = q_deps_rmd_inline(), + language = "markdown-inline", + ranges = code[, range_cols] + )[["matched_captures"]] + }) +}) diff --git a/tests/testthat/test-scan-deps.R b/tests/testthat/test-scan-deps.R new file mode 100644 index 00000000..fa78a224 --- /dev/null +++ b/tests/testthat/test-scan-deps.R @@ -0,0 +1,438 @@ +test_that("scan_deps", { + local_reproducible_output(width = 500) + withr::local_envvar(R_PKG_CACHE_DIR = tmp <- tempfile()) + on.exit(unlink(tmp), add = TRUE) + + project <- test_path("fixtures/scan/project-1") + expect_snapshot(variant = .Platform$OS.type, { + scan_deps(project)[] + }) + expect_snapshot(variant = .Platform$OS.type, { + scan_deps(project) + }) +}) + +test_that("get_deps_cache_path", { + local_reproducible_output(width = 500) + withr::local_envvar(R_PKG_CACHE_DIR = tmp <- tempfile()) + on.exit(unlink(tmp), add = TRUE) + + expect_snapshot(transform = transform_tempdir, { + writeLines(get_deps_cache_path()) + writeLines(get_deps_cache_path("badcafe")) + }) +}) + +test_that("clear_deps_cache", { + local_reproducible_output(width = 500) + withr::local_envvar(R_PKG_CACHE_DIR = tmp <- tempfile()) + on.exit(unlink(tmp), add = TRUE) + + cval <- get_deps_cache_path("badcafe") + mkdirp(dirname(cval)) + file.create(cval) + + expect_snapshot({ + dir(tmp, recursive = TRUE) + }) + + clear_deps_cache() + expect_snapshot({ + dir(tmp, recursive = TRUE) + }) +}) + +test_that("re_r_dep", { + expect_snapshot({ + re_r_dep() + }) +}) + +test_that("scan_path_deps", { + local_reproducible_output(width = 500) + withr::local_envvar(R_PKG_CACHE_DIR = tmp <- tempfile()) + on.exit(unlink(tmp), add = TRUE) + + rfile <- test_path("fixtures/scan/project-1/R/code.R") + expect_snapshot(variant = .Platform$OS.type, { + scan_path_deps(rfile) + }) + + # now from the cache + fake(scan_path_deps, "re_r_dep", function(...) stop("no")) + expect_snapshot(variant = .Platform$OS.type, { + scan_path_deps(rfile) + }) +}) + +test_that("scan_path_deps_empty", { + expect_snapshot({ + scan_path_deps_empty() + }) +}) + +test_that("scan_path_deps_do", { + rfile <- test_path("fixtures/scan/project-1/R/code.R") + expect_snapshot({ + scan_path_deps_do(readLines(rfile), basename(rfile)) + }) + + expect_snapshot(error = TRUE, { + scan_path_deps_do("code", "foo.unknown") + }) +}) + +test_that("scan_path_deps_do_r", { + local_reproducible_output(width = 500) + rfile <- test_path("fixtures/scan/project-1/R/code.R") + expect_snapshot({ + scan_path_deps_do_r(readLines(rfile), rfile) + }) +}) + +# test_that("scan_path_deps_do_pkg_hits", { }) + +test_that("scan_path_deps_do_fn_hits", { + local_reproducible_output(width = 500) + rfile <- test_path("fixtures/scan/methods.R") + expect_snapshot({ + scan_path_deps_do_r(readLines(rfile), rfile) + }) +}) + +# test_that("scan_path_deps_do_gen_hits", { }) + +test_that("scan_path_deps_do_jr_hits", { + local_reproducible_output(width = 500) + rfile <- test_path("fixtures/scan/junit.R") + expect_snapshot({ + scan_path_deps_do_r(readLines(rfile), rfile) + }) +}) + +test_that("scan_pat_deps_do_ragg_hits", { + local_reproducible_output(width = 500) + rfile <- test_path("fixtures/scan/knitr.Rmd") + expect_snapshot({ + scan_path_deps_do_rmd(readLines(rfile), rfile) + }) + rfile <- test_path("fixtures/scan/noragg.Rmd") + expect_snapshot({ + scan_path_deps_do_rmd(readLines(rfile), rfile) + }) +}) + +# test_that("scan_pat_deps_do_db_hits", { }) + +test_that("safe_parse_pkg_from_call", { + # error + expect_null( + safe_parse_pkg_from_call(NA_character_, "library", "library(error") + ) + expect_snapshot( + safe_parse_pkg_from_call(NA_character_, "library", "library(qwe)") + ) +}) + +# test_that("parse_pkg_from_call_match", { }) + +test_that("parse_pkg_from_call", { + expect_snapshot({ + parse_pkg_from_call(NA_character_, "library", "library(qwe)") + parse_pkg_from_call("base", "loadNamespace", "loadNamespace('q1')") + parse_pkg_from_call( + "base", "requireNamespace", "requireNamespace('q1')") + parse_pkg_from_call( + NA_character_, "pkg_attach", "pkg_attach('foobar')") + parse_pkg_from_call( + NA_character_, "pkg_attach2", "pkg_attach2('foobar')") + parse_pkg_from_call("pacman", "p_load", "p_load('p1')") + parse_pkg_from_call(NA_character_, "import", "import(x1)") + parse_pkg_from_call(NA_character_, "module", "module({import('x2')})") + parse_pkg_from_call("import", "from", "import::from(dplyr)") + parse_pkg_from_call( + "import", "into", "import::into('operators', .from = 'dplyr')") + parse_pkg_from_call("import", "here", "import::here('dplyr')") + parse_pkg_from_call("box", "use", "box::use(dplyr[filter, select])") + parse_pkg_from_call( + "targets", + "tar_option_set", + "tar_option_set(packages = c('p1', 'p2'))" + ) + parse_pkg_from_call( + "glue", + "glue", + "glue::glue('blah {library(x5)} blah')" + ) + parse_pkg_from_call( + NA_character_, "ggsave", "ggsave(filename = 'foo.svg')") + parse_pkg_from_call( + NA_character_, "set_engine", "set_engine(engine = 'spark')") + parse_pkg_from_call( + "R6", "R6Class", "R6::R6Class('foobar', inherit = JunitReporter)") + parse_pkg_from_call( + "testthat", "test_dir", "testthat::test_dir(reporter = 'junit')") + }) +}) + +test_that("parse_pkg_from_call_library", { + ppcl <- function(fn, code, ns = NA_character_) { + matched <- parse_pkg_from_call_match(fn, code) + parse_pkg_from_call_library(ns, fn, matched) + } + expect_null( + ppcl("library", "library(qqq)", ns = "other")) + expect_null( + ppcl("library", "library(qqq, character.only = TRUE)")) + expect_null( + ppcl("require", "require(qqq)", ns = "other")) + expect_null( + ppcl("require", "require(qqq, character.only = TRUE)")) + expect_snapshot({ + ppcl("library", "library(qqq)") + ppcl("library", "library('qqq')") + ppcl("library", "library(qqq)", ns = "base") + ppcl("require", "require(qqq)") + ppcl("require", "require('qqq')") + ppcl("require", "require('qqq')", ns = "base") + }) +}) + +test_that("parse_pkg_from_call_loadnamespace", { + ppcln <- function(fn, code, ns = NA_character_) { + matched <- parse_pkg_from_call_match(fn, code) + parse_pkg_from_call_loadnamespace(ns, fn, matched) + } + expect_null( + ppcln("loadNamespace", "loadNamespace('www')", ns = "other")) + expect_null( + ppcln("loadNamespace", "loadNamespace(www)")) + expect_null( + ppcln("loadNamespace", "loadNamespace(c('one', 'two'))")) + expect_null( + ppcln("loadNamespace", "loadNamespace(123)")) + expect_equal( + ppcln("loadNamespace", "loadNamespace('eee')"), + "eee") + expect_equal( + ppcln("loadNamespace", "loadNamespace('eee')", ns = "base"), + "eee") + + expect_null( + ppcln("requireNamespace", "requireNamespace('www')", ns = "other")) + expect_null( + ppcln("requireNamespace", "requireNamespace(www)")) + expect_null( + ppcln("requireNamespace", "requireNamespace(c('one', 'two'))")) + expect_null( + ppcln("requireNamespace", "requireNamespace(123)")) + expect_equal( + ppcln("requireNamespace", "requireNamespace('eee')"), + "eee") + expect_equal( + ppcln("requireNamespace", "requireNamespace('eee')", ns = "base"), + "eee") + }) + +test_that("parse_pkg_from_call_xfun", { + ppcx <- function(fn, code, ns = NA_character_) { + matched <- parse_pkg_from_call_match(fn, code) + parse_pkg_from_call_xfun(ns, fn, matched) + } + expect_null( + ppcx("pkg_attach", "pkg_attach('qwe')", ns = "nope")) + expect_null( + ppcx("pkg_attach", "pkg_attach()")) + expect_equal( + ppcx("pkg_attach", "pkg_attach('p1', 'p2', 'p3')"), + c("p1", "p2", "p3")) + expect_equal( + ppcx("pkg_attach2", "pkg_attach2('p1', 'p2', 'p3')"), + c("p1", "p2", "p3")) +}) + +test_that("parse_pkg_from_call_pacman", { + ppcp <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("p_load", code) + parse_pkg_from_call_pacman(ns, fn, matched) + } + expect_null(ppcp("p_load()", ns = "foo")) + expect_null(ppcp("p_load(xx, character.only = TRUE)")) + expect_equal(ppcp("p_load(p1, 'p2', p3)"), c("p1", "p2", "p3")) + expect_equal(ppcp("p_load(char = 'pp')"), 'pp') + expect_equal(ppcp("p_load(char = c('p1', 'p2'))"), c("p1", "p2")) +}) + +test_that("parse_pkg_from_call_modules_import", { + ppcmi <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("import", code) + parse_pkg_from_call_modules_import(ns, fn, matched) + } + expect_null(ppcmi("import('pp')", ns = "foo")) + expect_null(ppcmi("import(NULL)")) + expect_equal(ppcmi("import('pp')"), 'pp') + expect_equal(ppcmi("import(pp)"), 'pp') +}) + +test_that("parse_pkg_from_call_modules_module", { + ppcmm <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("module", code) + parse_pkg_from_call_modules_module(ns, fn, matched) + } + expect_null(ppcmm("module(x)", ns = "foo")) + expect_null(ppcmm('module({})')) + expect_equal( + ppcmm("module({ + # other expressions, mixed with import() + pkg::fun() + blah + blah + import(p1) + baaaaah + import('p2') + })"), + c('p1', 'p2') + ) +}) + +test_that("parse_pkg_from_call_import", { + ppci <- function(fn, code, ns = NA_character_) { + matched <- parse_pkg_from_call_match(fn, code) + parse_pkg_from_call_import(ns, fn, matched) + } + expect_null(ppci("from", "import::from(foo)", ns = "xx")) + expect_equal(ppci("from", "import::from(foo)"), "foo") + expect_equal(ppci("from", "import::from('foo')"), "foo") + expect_equal(ppci("here", "import::here(foo)"), "foo") + expect_equal(ppci("here", "import::here('foo')"), "foo") + expect_equal(ppci("into", "import::into(.from = foo)"), "foo") + expect_equal(ppci("into", "import::into(.from = 'foo')"), "foo") + expect_null(ppci("from", "import::from(xx, .character_only = TRUE)")) + expect_null(ppci("from", "import::from('./path.R')")) +}) + +test_that("parse_pkg_from_call_box", { + ppcb <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("use", code) + parse_pkg_from_call_box(ns, fn, matched) + } + expect_null(ppcb("box::use(pkg)", ns = 'not')) + expect_null(ppcb("box::use(foo/bar)")) + expect_null(ppcb("box::use(.[ff])")) + expect_null(ppcb("box::use(..[ff])")) + expect_equal(ppcb("box::use(pkg)"), "pkg") + expect_equal(ppcb("box::use(pkg[f1, f2])"), c("pkg")) + expect_equal(ppcb("box::use(pkg0, pkg[f1, f2])"), c("pkg0", "pkg")) +}) + +test_that("parse_pkg_from_call_targets", { + ppct <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("tar_option_set", code) + parse_pkg_from_call_targets(ns, fn, matched) + } + expect_null(ppct("tar_option_set(packages = 'pp')", ns = 'not')) + expect_null(ppct("tar_option_set()")) + expect_equal( + ppct("tar_option_set(packages = { 1:10; c('p1', 'p2') })"), + c("p1", "p2") + ) +}) + +test_that("dependencies_eval", { + expect_snapshot({ + dependencies_eval(quote({ 1:10; c(10:1)[1:3] })) + }) +}) + +test_that("parse_pkg_from_call_glue", { + ppcg <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("glue", code) + parse_pkg_from_call_glue(ns, fn, matched) + } + expect_null(ppcg("glue('{library(xx)}')", ns = "nope")) + expect_null(ppcg("glue('no code at all')")) + expect_equal( + ppcg("glue('some {library(p1)} code {p2::f()}')"), + c("p1", "p2") + ) +}) + +test_that("parse_pkg_from_call_ggplot2", { + ppcgg <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("ggsave", code) + parse_pkg_from_call_ggplot2(ns, fn, matched) + } + expect_null(ppcgg("ggsave(filename = 'foo.svg')", ns = 'not')) + expect_null(ppcgg("ggsave(filename = 'foo.png')")) + expect_null(ppcgg("ggsave(filename = var)")) + expect_equal(ppcgg("ggsave(filename = 'foo.svg')"), "svglite") +}) + +test_that("parse_pkg_from_call_parsnip", { + ppcp <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("set_engine", code) + parse_pkg_from_call_parsnip(ns, fn, matched) + } + expect_null(ppcp("set_engine(engine = 'keras')", ns = "nope")) + expect_null(ppcp("set_engine()")) + withr::local_options(renv.parsnip.engines = NULL) + expect_equal(ppcp("set_engine(engine = 'glm')"), "stats") + withr::local_options(renv.parsnip.engines = list(foo = "bar")) + expect_equal(ppcp("set_engine(engine = 'foo')"), "bar") + withr::local_options(renv.parsnip.engines = function(x) "eng") + expect_equal(ppcp("set_engine(engine = 'foo')"), "eng") + withr::local_options(renv.parsnip.engines = function(x) NULL) + expect_null(ppcp("set_engine(engine = 'foo')")) +}) + +test_that("parse_pkg_from_call_testthat_r6class", { + ppcttr6 <- function(code, ns = NA_character_) { + matched <- parse_pkg_from_call_match("R6Class", code) + parse_pkg_from_call_testthat_r6class(ns, fn, matched) + } + expect_null(ppcttr6("R6Class(inherit = JunitReporter)", ns = 'not')) + expect_null(ppcttr6("R6Class(inherit = someother)")) + expect_equal(ppcttr6("R6Class(inherit = JunitReporter)"), "xml2") + expect_equal( + ppcttr6("R6Class(inherit = testthat::JunitReporter)"), "xml2") +}) + +test_that("parse_pkg_from_call_testthat_test", { + ppcttt <- function(fn, code, ns = NA_character_) { + matched <- parse_pkg_from_call_match(fn, code) + parse_pkg_from_call_testthat_test(ns, fn, matched) + } + expect_null( + ppcttt("test_dir", "test_dir(reporter = 'junit')", ns = "other")) + expect_null( + ppcttt("test_dir", "test_dir(reporter = 'other')")) + expect_equal( + ppcttt("test_dir", "test_dir(reporter = 'junit')"), + "xml2") +}) + +test_that("scan_path_deps_do_rmd", { + local_reproducible_output(width = 500) + path <- test_path("fixtures/scan/chunk-errors.Rmd") + expect_snapshot({ + scan_path_deps_do_rmd(readLines(path), "chunk-errors.Rmd") + }) +}) + +test_that("scan_path_deps_do_rmd #2", { + local_reproducible_output(width = 500) + path <- test_path("fixtures/scan/inline-chunks.Rmd") + expect_snapshot({ + scan_path_deps_do_rmd(readLines(path), "inline-chunks.Rmd") + }) +}) + +test_that("scan_path_deps_do_rmd #3", { + local_reproducible_output(width = 500) + path <- test_path("fixtures/scan/nothing.Rmd") + expect_snapshot({ + scan_path_deps_do_rmd(readLines(path), "nothing.Rmd") + }) +}) + +# test_that("scan_path_deps_do_inline_hits", { }) +# test_that("scan_path_deps_do_block_hits", { })