diff --git a/R/scan-deps-queries.R b/R/scan-deps-queries.R index 03cfec49..a491a470 100644 --- a/R/scan-deps-queries.R +++ b/R/scan-deps-queries.R @@ -12,7 +12,8 @@ q_library_0 <- function() { "tar_option_set" "glue" "ggsave" - "set_engine"))', + "set_engine" + "R6Class" "test_package" "test_dir" "test_file"))', '((call function: (namespace_operator lhs: (identifier) @ns-name @@ -21,7 +22,7 @@ q_library_0 <- function() { ) @dep-code (#any-of? @ns-name "base" "xfun" "pacman" "modules" "import" "box" "targets" "glue" - "ggplot2" "parsnip") + "ggplot2" "parsnip" "R6" "testthat") (#any-of? @fn-name "library" "require" "loadNamespace" "requireNamespace" "pkg_attach" "pkg_attach2" @@ -32,7 +33,8 @@ q_library_0 <- function() { "tar_option_set" "glue" "ggsave" - "set_engine"))' + "set_engine" + "R6Class" "test_package" "test_dir" "test_file"))' ), names = rep("q_library_0", 2)) } @@ -66,11 +68,36 @@ q_methods <- function() { ) } +q_junit_reporter <- function() { + structure(c( + '((call function: + (extract_operator + lhs: (identifier) @class-name + rhs: (identifier) @method-name + ) + ) @dep-code + (#eq? @class-name "JunitReporter") + (#eq? @method-name "new"))', + '((call function: + (extract_operator + lhs: (namespace_operator + lhs: (identifier) @pkg-name + rhs: (identifier) @class-name) + rhs: (identifier) @method-name + ) + ) @dep-code + (#eq? @pkg-name "testthat") + (#eq? @class-name "JunitReporter") + (#eq? @method-name "new"))' + ), names = rep("junit_reporter", 2)) +} + q_deps <- function() { c( q_library_0(), q_colon(), q_methods(), + q_junit_reporter(), NULL ) } diff --git a/R/scan-deps.R b/R/scan-deps.R index 459c932c..dee95876 100644 --- a/R/scan-deps.R +++ b/R/scan-deps.R @@ -117,11 +117,17 @@ scan_path_deps_do_r <- function(code, path, ranges = NULL) { fn_pat <- hits$patterns$id[hits$patterns$name %in% fn_patterns] fn_hits <- mct[mct$pattern %in% fn_pat, ] - pkg_hits <- mct[! mct$pattern %in% c(gen_pat, fn_pat), ] + # junit reporter needs xml2 + jr_patterns <- "junit_reporter" + jr_pat <- hits$patterns$id[hits$patterns$name %in% jr_patterns] + jr_hits <- mct[mct$pattern %in% jr_pat, ] + + pkg_hits <- mct[! mct$pattern %in% c(gen_pat, fn_pat, jr_pat), ] rbind( if (nrow(pkg_hits) > 0) scan_path_deps_do_pkg_hits(pkg_hits, path), if (nrow(fn_hits) > 0) scan_path_deps_do_fn_hits(fn_hits, path), - if (nrow(gen_hits) > 0) scan_path_deps_do_gen_hits(gen_hits, path) + if (nrow(gen_hits) > 0) scan_path_deps_do_gen_hits(gen_hits, path), + if (nrow(jr_hits) > 0) scan_path_deps_do_jr_hits(jr_hits, path) ) } @@ -176,6 +182,19 @@ scan_path_deps_do_gen_hits <- function(hits, path) { ) } +scan_path_deps_do_jr_hits <- function(hits, path) { + code <- hits$code[hits$name == "dep-code"] + data_frame( + path = path, + package = "xml2", + type = get_dep_type_from_path(path), + code = code, + start_row = hits$start_row[hits$name == "dep-code"], + start_column = hits$start_column[hits$name == "dep-code"], + start_byte = hits$start_byte[hits$name == "dep-code"] + ) +} + prot_xfun_pkg_attach <- function(..., install, message) { } prot_xfun_pkg_attach2 <- function(...) { } prot_pacman_p_load <- function(..., char, install, update, character.only) { } @@ -195,6 +214,12 @@ prot_glue_glue <- function( } prot_ggplot2_ggsave <- function(filename, ...) { } prot_parsnip_set_engine <- function(object, engine, ...) { } +prot_r6_r6class <- function( + classname = NULL, public = list(), private = NULL, active = NULL, + inherit = NULL, ...) { } +prot_testthat_test_package <- function(package, reporter = NULL, ...) { } +prot_testthat_test_dir <- function(path, filter = NULL, reporter = NULL, ...) { } +prot_testthat_test_file <- function(path, reporter = NULL, ...) { } safe_parse_pkg_from_call <- function(ns, fn, code) { tryCatch( @@ -222,7 +247,11 @@ parse_pkg_from_call <- function(ns, fn, code) { "tar_option_set" = prot_targets_tar_option_set, "glue" = prot_glue_glue, "ggsave" = prot_ggplot2_ggsave, - "set_engine" = prot_parsnip_set_engine + "set_engine" = prot_parsnip_set_engine, + "R6Class" = prot_r6_r6class, + "test_package" = prot_testthat_test_package, + "test_dir" = prot_testthat_test_dir, + "test_file" = prot_testthat_test_file ) matched <- match.call(fun, expr, expand.dots = FALSE) switch(fn, @@ -249,7 +278,11 @@ parse_pkg_from_call <- function(ns, fn, code) { "ggsave" = parse_pkg_from_call_ggplot2(ns, fn, matched), "set_engine" = - parse_pkg_from_call_parsnip(ns, fn, matched) + parse_pkg_from_call_parsnip(ns, fn, matched), + "R6Class" = + parse_pkg_from_call_testthat_r6class(ns, fn, matched), + "test_package" = , "test_dir" = , "test_file" = + parse_pkg_from_call_testthat_test(ns, fn, matched) ) } @@ -461,6 +494,28 @@ parse_pkg_from_call_parsnip <- function(ns, fn, matched) { NULL } +parse_pkg_from_call_testthat_r6class <- function(ns, fn, matched) { + if (!is.na(ns) && ns != "R6") return(NULL) + inherit <- matched[["inherit"]] + if (identical(inherit, quote(JunitReporter)) || + identical(inherit, quote(testthat::JunitReporter))) { + return("xml2") + } + NULL +} + +parse_pkg_from_call_testthat_test <- function(ns, fn, matched) { + if (!is.na(ns) && ns != "testthat") return(NULL) + reporter <- matched[["reporter"]] + if (identical(reporter, "Junit") || + identical(reporter, "junit") || + identical(reporter, quote(JunitReporter)) || + identical(reporter, quote(JunitReporter))) { + return("xml2") + } + NULL +} + # ------------------------------------------------------------------------- scan_path_deps_do_rmd <- function(code, path) {