diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index bd8db35..51f3b16 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -24,6 +24,7 @@ jobs: - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} - {os: ubuntu-latest, r: 'release'} - {os: ubuntu-latest, r: 'oldrel-1'} + - {os: ubuntu-latest, r: '3.6'} env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} @@ -38,6 +39,7 @@ jobs: with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} + use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: @@ -47,4 +49,4 @@ jobs: - uses: r-lib/actions/check-r-package@v2 with: upload-snapshots: true - build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' \ No newline at end of file diff --git a/.github/workflows/pkgdown.yaml b/.github/workflows/pkgdown.yaml index 66f1eed..ab016ab 100644 --- a/.github/workflows/pkgdown.yaml +++ b/.github/workflows/pkgdown.yaml @@ -29,7 +29,10 @@ jobs: - uses: r-lib/actions/setup-r@v2 with: - extra-repositories: https://visruthsk.r-universe.dev + use-public-rspm: true + extra-repositories: | + https://community.r-multiverse.org + https://visruthsk.r-universe.dev - uses: r-lib/actions/setup-r-dependencies@v2 with: @@ -46,4 +49,4 @@ jobs: with: clean: false branch: gh-pages - folder: docs + folder: docs \ No newline at end of file diff --git a/DESCRIPTION b/DESCRIPTION index 9dd6f31..6cdebae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: ascribe Title: Static Detection and Citation of R Package and Function Usage -Version: 0.2.0.9000 +Version: 0.3.0 Authors@R: person("Visruth", "Srimath Kandali", , "public@visruth.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0009-0005-9097-0688")) @@ -14,7 +14,7 @@ License: MIT + file LICENSE URL: https://ascribe.visruth.com BugReports: https://github.com/VisruthSK/ascribe/issues Depends: - R (>= 4.2.0) + R (>= 3.6.0) Imports: brio, cli, diff --git a/R/cite_usage.R b/R/cite_usage.R index 862e1e5..2a59afd 100644 --- a/R/cite_usage.R +++ b/R/cite_usage.R @@ -13,6 +13,8 @@ #' @param always_cite Character vector of packages to cite in addition to the #' packages found by the scan. #' @param format One of `"bibtex"` or `"bibentry"`. +#' @param cite_r Whether to include an automatic R base citation. Defaults +#' to `TRUE`. #' @return A BibTeX character vector or a bibentry object. #' @export #' @examples @@ -21,6 +23,7 @@ #' universe <- build_universe_data(c("cli", "fastmatch")) #' usage <- scan_usage(path, universe) #' cite_usage(usage) +#' cite_usage(usage, cite_r = FALSE) #' unlink(path) cite_usage <- function( usage, @@ -28,15 +31,17 @@ cite_usage <- function( function_citations = new.env(parent = emptyenv(), hash = TRUE), package_citation = utils::citation, always_cite = character(), - format = c("bibtex", "bibentry") + format = c("bibtex", "bibentry"), + cite_r = TRUE ) { pkgs <- unique(c(usage$packages, always_cite)) if (!length(pkgs) && !length(usage$functions)) { return(character()) } + base_pkgs <- if (cite_r) "base" else character() entries <- c( - lapply(unique(c(pkgs, "base")), \(pkg) { + lapply(unique(c(pkgs, base_pkgs)), function(pkg) { entry <- get0( pkg, envir = package_citations, @@ -49,13 +54,12 @@ cite_usage <- function( entry } }), - lapply(usage$functions, \(fun) { + lapply(usage$functions, function(fun) { get0(fun, envir = function_citations, inherits = FALSE, ifnotfound = NULL) }) - ) |> - Filter(Negate(is.null), x = _) |> - do.call(c, args = _) |> - unique() + ) + + entries <- unique(do.call(c, Filter(Negate(is.null), entries))) if (match.arg(format) == "bibentry") entries else utils::toBibtex(entries) } diff --git a/R/collect.R b/R/collect.R index f6fc3e0..2d7b78a 100644 --- a/R/collect.R +++ b/R/collect.R @@ -11,15 +11,15 @@ collect_pkg_funs <- function(pkg) { ns <- asNamespace(pkg) - getNamespaceExports(pkg) |> + unique(c( Filter( - \(x) { + function(x) { is.function(tryCatch(getExportedValue(ns, x), error = function(e) NULL)) }, - x = _ - ) |> - c(collect_r6_methods(pkg)) |> - unique() + getNamespaceExports(pkg) + ), + collect_r6_methods(pkg) + )) } #' Collect R6 class method names from a package @@ -33,36 +33,43 @@ collect_pkg_funs <- function(pkg) { collect_r6_methods <- function(pkg) { ns <- asNamespace(pkg) - namespace_r6 <- ls(ns, all.names = TRUE) |> + namespace_r6 <- Filter( + Negate(is.null), lapply( - \(name) { + ls(ns, all.names = TRUE), + function(name) { obj <- tryCatch( get0(name, envir = ns, inherits = FALSE), error = function(e) NULL ) if (inherits(obj, "R6ClassGenerator")) obj else NULL } - ) |> - Filter(Negate(is.null), x = _) + ) + ) - exported_r6 <- getNamespaceExports(ns) |> + exported_r6 <- Filter( + Negate(is.null), lapply( - \(name) { + getNamespaceExports(ns), + function(name) { obj <- tryCatch( getExportedValue(ns, name), error = function(e) NULL ) if (inherits(obj, "R6ClassGenerator")) obj else NULL } - ) |> - Filter(Negate(is.null), x = _) + ) + ) - c(namespace_r6, exported_r6) |> - lapply(\(gen) names(gen$public_methods)) |> - unlist(use.names = FALSE) |> - as.character() |> - (\(methods) methods[!is.na(methods) & nzchar(methods)])() |> - unique() + methods <- unlist( + lapply( + c(namespace_r6, exported_r6), + function(gen) names(gen$public_methods) + ), + use.names = FALSE + ) + methods <- as.character(methods) + unique(methods[!is.na(methods) & nzchar(methods)]) } .resolve_origin_ns <- function(ns, name) { @@ -151,7 +158,9 @@ build_origin_map <- function(exports) { u_pkgs <- unique(all_pkgs) ns_list <- stats::setNames( - lapply(u_pkgs, \(p) tryCatch(asNamespace(p), error = function(e) NULL)), + lapply(u_pkgs, function(p) { + tryCatch(asNamespace(p), error = function(e) NULL) + }), u_pkgs ) diff --git a/R/scan_usage.R b/R/scan_usage.R index a0ecaea..e806e18 100644 --- a/R/scan_usage.R +++ b/R/scan_usage.R @@ -93,7 +93,7 @@ scan_usage <- function( } lapply( paths, - \(file_path) cli::cli_alert_info("Searching {.path {file_path}}") + function(file_path) cli::cli_alert_info("Searching {.path {file_path}}") ) paths } @@ -116,7 +116,7 @@ scan_usage <- function( hits <- lapply( unique(files), - \(file) { + function(file) { code_str <- .extract_code( file, skip_patterns = skip_patterns, @@ -130,7 +130,8 @@ scan_usage <- function( metapackages = metapackages, walker = walker, file_path = file, - skip_patterns = if (is_r) NULL else skip_patterns + skip_patterns = if (is_r) NULL else skip_patterns, + explicit_only = !is.null(metapackages) && length(metapackages) > 0L ) } ) @@ -215,11 +216,7 @@ scan_usage <- function( } .collect_unique <- function(hits, field) { - hits |> - lapply(`[[`, field) |> - unlist(use.names = FALSE) |> - unique() |> - sort() + sort(unique(unlist(lapply(hits, `[[`, field), use.names = FALSE))) } # Chunks pkgs into word-boundary alternation regexes (PCRE limits how many @@ -238,7 +235,7 @@ scan_usage <- function( ) vapply( chunks, - \(chk) { + function(chk) { escaped <- gsub("([][{}()+*^$|\\\\.?])", "\\\\\\1", chk) paste0("\\b(", paste(escaped, collapse = "|"), ")\\b") }, @@ -265,7 +262,9 @@ scan_usage <- function( lapply( metapackages, - \(pkgs) unique(pkgs[!is.na(fastmatch::fmatch(pkgs, allowed_packages))]) + function(pkgs) { + unique(pkgs[!is.na(fastmatch::fmatch(pkgs, allowed_packages))]) + } ) } @@ -279,9 +278,7 @@ scan_usage <- function( skip_patterns = NULL, use_knitr = FALSE ) { - ext <- file |> - sub(".*\\.", "", x = _) |> - tolower() + ext <- tolower(sub(".*\\.", "", file)) if (!ext %in% c("r", "rmd", "qmd")) { cli::cli_abort(c( @@ -437,7 +434,11 @@ scan_usage <- function( metapackages, walker, file_path, - skip_patterns = .build_skip_patterns(c(allowed_packages, names(metapackages))) + skip_patterns = .build_skip_patterns(c( + allowed_packages, + names(metapackages) + )), + explicit_only = FALSE ) { empty <- list(pkgs = character(), keys = character(), ambiguous = character()) if (!any(nzchar(code))) { @@ -457,7 +458,7 @@ scan_usage <- function( c, lapply( code, - \(chunk) { + function(chunk) { tryCatch( parse(text = chunk, keep.source = FALSE), error = function(e) NULL @@ -486,6 +487,7 @@ scan_usage <- function( acc$lib_pkgs <- character() acc$lib_visit_idx <- integer() acc$lib_is_attach <- logical() + acc$lib_is_explicit <- logical() acc$ns_pkgs <- character() acc$ns_keys <- character() acc$unqual_funs <- character() @@ -499,7 +501,8 @@ scan_usage <- function( list( visit_idx = acc$lib_visit_idx, pkg = acc$lib_pkgs, - is_attach = acc$lib_is_attach + is_attach = acc$lib_is_attach, + is_explicit = acc$lib_is_explicit ) } else { NULL @@ -520,8 +523,14 @@ scan_usage <- function( resolver_index = resolver_index ) + explicit_pkgs <- if (explicit_only) { + lib_data$pkg[lib_data$is_explicit] + } else { + lib_data$pkg[lib_data$is_attach] + } + list( - pkgs = c(acc$lib_pkgs, acc$ns_pkgs, resolved$pkgs), + pkgs = c(explicit_pkgs, acc$ns_pkgs, resolved$pkgs), keys = c(acc$ns_keys, resolved$keys), ambiguous = resolved$ambiguous ) @@ -597,25 +606,37 @@ scan_usage <- function( if (!is.null(pkg)) { is_allowed <- !is.null(allowed_pkgs_env[[pkg]]) is_attach <- kind == 3L + is_metapkg <- !is.null(metapackages) && + !is.null(metapackages[[pkg]]) - if (is_allowed) { + if (is_allowed || is_metapkg) { acc$lib_pkgs <- c(acc$lib_pkgs, pkg) acc$lib_visit_idx <- c(acc$lib_visit_idx, acc$visit_idx) acc$lib_is_attach <- c(acc$lib_is_attach, is_attach) + acc$lib_is_explicit <- c(acc$lib_is_explicit, is_attach) } if (is_attach && !is.null(metapackages)) { expanded_pkgs <- metapackages[[pkg]] if (length(expanded_pkgs)) { - acc$lib_pkgs <- c(acc$lib_pkgs, expanded_pkgs) - acc$lib_visit_idx <- c( - acc$lib_visit_idx, - rep.int(acc$visit_idx, length(expanded_pkgs)) - ) - acc$lib_is_attach <- c( - acc$lib_is_attach, - rep.int(TRUE, length(expanded_pkgs)) - ) + allowed_expanded <- expanded_pkgs[ + !is.na(fastmatch::fmatch(expanded_pkgs, allowed_packages)) + ] + if (length(allowed_expanded)) { + acc$lib_pkgs <- c(acc$lib_pkgs, allowed_expanded) + acc$lib_visit_idx <- c( + acc$lib_visit_idx, + rep.int(acc$visit_idx, length(allowed_expanded)) + ) + acc$lib_is_attach <- c( + acc$lib_is_attach, + rep.int(TRUE, length(allowed_expanded)) + ) + acc$lib_is_explicit <- c( + acc$lib_is_explicit, + rep.int(FALSE, length(allowed_expanded)) + ) + } } } } @@ -913,7 +934,7 @@ scan_usage <- function( cbind, lapply( meta$provider, - \(pkg) { + function(pkg) { provider_rows <- attached_rows[[pkg]] hits <- findInterval(visit_idx, attached$visit_idx[provider_rows]) out <- rep.int(-1L, length(visit_idx)) diff --git a/R/universe.R b/R/universe.R index 27ae976..4fcd41c 100644 --- a/R/universe.R +++ b/R/universe.R @@ -33,7 +33,7 @@ build_universe_data <- function(packages) { origin_map <- build_origin_map(exports) pkg_versions <- stats::setNames( - lapply(packages, \(p) as.character(utils::packageVersion(p))), + lapply(packages, function(p) as.character(utils::packageVersion(p))), packages ) diff --git a/data-raw/sysdata.R b/data-raw/sysdata.R index 06854a0..50aee2d 100644 --- a/data-raw/sysdata.R +++ b/data-raw/sysdata.R @@ -5,13 +5,13 @@ # - .scan_skip_dirs: directory names to skip when scanning projects # Precompute standard library functions -.stdlib_funs <- lapply( - c("base", "stats", "utils", "graphics", "grDevices", "methods"), - getNamespaceExports -) |> - unlist(use.names = FALSE) |> - unique() |> - sort() +.stdlib_funs <- sort(unique(unlist( + lapply( + c("base", "stats", "utils", "graphics", "grDevices", "methods"), + getNamespaceExports + ), + use.names = FALSE +))) # Default skip directories .scan_skip_dirs <- c( diff --git a/man/cite_usage.Rd b/man/cite_usage.Rd index 2f6a84a..0564521 100644 --- a/man/cite_usage.Rd +++ b/man/cite_usage.Rd @@ -10,7 +10,8 @@ cite_usage( function_citations = new.env(parent = emptyenv(), hash = TRUE), package_citation = utils::citation, always_cite = character(), - format = c("bibtex", "bibentry") + format = c("bibtex", "bibentry"), + cite_r = TRUE ) } \arguments{ @@ -29,6 +30,9 @@ its citation entries. Defaults to \code{\link[utils:citation]{utils::citation()} packages found by the scan.} \item{format}{One of \code{"bibtex"} or \code{"bibentry"}.} + +\item{cite_r}{Whether to include an automatic R base citation. Defaults +to \code{TRUE}.} } \value{ A BibTeX character vector or a bibentry object. @@ -43,5 +47,6 @@ writeLines("cli::cli_alert_info('hi'); fastmatch::fmatch(1, 1:5)", path) universe <- build_universe_data(c("cli", "fastmatch")) usage <- scan_usage(path, universe) cite_usage(usage) +cite_usage(usage, cite_r = FALSE) unlink(path) } diff --git a/tests/testthat/fixtures/ascribetestbroken/DESCRIPTION b/tests/testthat/fixtures/ascribetestbroken/DESCRIPTION new file mode 100644 index 0000000..81b36f8 --- /dev/null +++ b/tests/testthat/fixtures/ascribetestbroken/DESCRIPTION @@ -0,0 +1,7 @@ +Package: ascribetestbroken +Version: 0.0.1 +Title: Test Fixture for Ascribe Broken Namespace Handling +Description: Minimal package with an erroring active binding. +Authors@R: person("Ascribe", "Tests", email = "tests@ascribe.test", role = c("aut", "cre")) +License: MIT +Imports: R6 \ No newline at end of file diff --git a/tests/testthat/fixtures/ascribetestbroken/NAMESPACE b/tests/testthat/fixtures/ascribetestbroken/NAMESPACE new file mode 100644 index 0000000..d626f7b --- /dev/null +++ b/tests/testthat/fixtures/ascribetestbroken/NAMESPACE @@ -0,0 +1 @@ +export(SomeClass) \ No newline at end of file diff --git a/tests/testthat/fixtures/ascribetestbroken/R/code.R b/tests/testthat/fixtures/ascribetestbroken/R/code.R new file mode 100644 index 0000000..ed2c8fe --- /dev/null +++ b/tests/testthat/fixtures/ascribetestbroken/R/code.R @@ -0,0 +1,12 @@ +# jarl-ignore unused_function: package load hook called by R +.onLoad <- function(libname, pkgname) { + ns <- asNamespace(pkgname) + makeActiveBinding("broken", function() stop("boom"), env = ns) +} + +SomeClass <- R6::R6Class( + "SomeClass", + public = list( + method = function() "upstream" + ) +) diff --git a/tests/testthat/fixtures/ascribetestdownstreamr6/DESCRIPTION b/tests/testthat/fixtures/ascribetestdownstreamr6/DESCRIPTION new file mode 100644 index 0000000..a7a7694 --- /dev/null +++ b/tests/testthat/fixtures/ascribetestdownstreamr6/DESCRIPTION @@ -0,0 +1,7 @@ +Package: ascribetestdownstreamr6 +Version: 0.0.1 +Title: Test Fixture for Ascribe R6 Re-export Handling +Description: Minimal downstream package for testing R6 re-export detection. +Authors@R: person("Ascribe", "Tests", email = "tests@ascribe.test", role = c("aut", "cre")) +License: MIT +Imports: ascribetestupstreamr6 \ No newline at end of file diff --git a/tests/testthat/fixtures/ascribetestdownstreamr6/NAMESPACE b/tests/testthat/fixtures/ascribetestdownstreamr6/NAMESPACE new file mode 100644 index 0000000..8b91f0d --- /dev/null +++ b/tests/testthat/fixtures/ascribetestdownstreamr6/NAMESPACE @@ -0,0 +1,2 @@ +importFrom(ascribetestupstreamr6, ExportedClass) +export(ExportedClass) \ No newline at end of file diff --git a/tests/testthat/fixtures/ascribetestupstreamr6/DESCRIPTION b/tests/testthat/fixtures/ascribetestupstreamr6/DESCRIPTION new file mode 100644 index 0000000..6aed18c --- /dev/null +++ b/tests/testthat/fixtures/ascribetestupstreamr6/DESCRIPTION @@ -0,0 +1,7 @@ +Package: ascribetestupstreamr6 +Version: 0.0.1 +Title: Test Fixture for Ascribe R6 Discovery +Description: Minimal package with exported and internal R6 classes for testing collect_r6_methods. +Authors@R: person("Ascribe", "Tests", email = "tests@ascribe.test", role = c("aut", "cre")) +License: MIT +Imports: R6 \ No newline at end of file diff --git a/tests/testthat/fixtures/ascribetestupstreamr6/NAMESPACE b/tests/testthat/fixtures/ascribetestupstreamr6/NAMESPACE new file mode 100644 index 0000000..80d882d --- /dev/null +++ b/tests/testthat/fixtures/ascribetestupstreamr6/NAMESPACE @@ -0,0 +1 @@ +export(ExportedClass) \ No newline at end of file diff --git a/tests/testthat/fixtures/ascribetestupstreamr6/R/classes.R b/tests/testthat/fixtures/ascribetestupstreamr6/R/classes.R new file mode 100644 index 0000000..033e90e --- /dev/null +++ b/tests/testthat/fixtures/ascribetestupstreamr6/R/classes.R @@ -0,0 +1,13 @@ +ExportedClass <- R6::R6Class( + "ExportedClass", + public = list( + exported_method = function() "exported" + ) +) + +InternalClass <- R6::R6Class( + "InternalClass", + public = list( + internal_method = function() "internal" + ) +) diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index faef804..650183e 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -1,5 +1,44 @@ options(cli.default_handler = function(msg) invisible(NULL)) +# Single fixture installation helper - accepts one or more fixture names +with_fixtures <- function(fixture_names, code) { + skip_if_not_installed("R6") + + tmp_lib <- tempfile() + dir.create(tmp_lib) + old_lib <- .libPaths() + + on.exit( + { + # Unload fixture namespaces in reverse order + for (pkg in rev(fixture_names)) { + if (isNamespaceLoaded(pkg)) { + unloadNamespace(pkg) + } + } + .libPaths(old_lib) + unlink(tmp_lib, recursive = TRUE) + }, + add = TRUE + ) + + .libPaths(c(tmp_lib, old_lib)) + + for (fixture_name in fixture_names) { + fixture_dir <- testthat::test_path("fixtures", fixture_name) + utils::install.packages( + fixture_dir, + repos = NULL, + type = "source", + lib = tmp_lib, + INSTALL_opts = c("--no-staged-install", "--no-test-load"), + quiet = TRUE + ) + } + + code() +} + test_universe <- function(packages, export_index = list(), origin_map = NULL) { if (is.null(origin_map)) { origin_map <- new.env(parent = emptyenv()) diff --git a/tests/testthat/test-cite_usage.R b/tests/testthat/test-cite_usage.R index 6b10193..f480f70 100644 --- a/tests/testthat/test-cite_usage.R +++ b/tests/testthat/test-cite_usage.R @@ -287,3 +287,44 @@ test_that("cite_usage handles environment-based citations and fallback branches" character() ) }) + +test_that("cite_usage cite_r parameter controls automatic R base citation", { + usage <- structure( + list(packages = "cli", functions = character()), + class = "scan_usage" + ) + + # Use a non-base package to avoid utils::citation returning R citation + with_cite_r <- cite_usage( + usage, + cite_r = TRUE, + package_citation = function(pkg) utils::citation(pkg), + format = "bibentry" + ) + bibtex_with <- utils::toBibtex(with_cite_r) + expect_true(any(grepl("R Core Team", bibtex_with, fixed = TRUE))) + + without_cite_r <- cite_usage( + usage, + cite_r = FALSE, + package_citation = function(pkg) utils::citation(pkg), + format = "bibentry" + ) + bibtex_without <- utils::toBibtex(without_cite_r) + expect_false(any(grepl("R Core Team", bibtex_without, fixed = TRUE))) + expect_true(any(grepl("cli", bibtex_without, fixed = TRUE))) + + # When base is explicitly in packages, it should still be cited + usage_with_base <- structure( + list(packages = c("cli", "base"), functions = character()), + class = "scan_usage" + ) + explicit_base <- cite_usage( + usage_with_base, + cite_r = FALSE, + package_citation = function(pkg) utils::citation(pkg), + format = "bibentry" + ) + bibtex_explicit <- utils::toBibtex(explicit_base) + expect_true(any(grepl("R Core Team", bibtex_explicit, fixed = TRUE))) +}) diff --git a/tests/testthat/test-collect.R b/tests/testthat/test-collect.R index 28b6e8a..a3f9e89 100644 --- a/tests/testthat/test-collect.R +++ b/tests/testthat/test-collect.R @@ -11,71 +11,26 @@ test_that("collect_r6_methods returns empty vector when no R6 classes exist", { }) test_that("collect_r6_methods finds exported and internal R6 methods", { - methods <- collect_r6_methods("testthat") - expect_true("public_fun" %in% methods) - expect_false(anyNA(methods)) - expect_true(all(nzchar(methods))) -}) + with_fixtures("ascribetestupstreamr6", function() { + methods <- collect_r6_methods("ascribetestupstreamr6") -test_that("collect_r6_methods survives erroring namespace bindings", { - skip_if_not_installed("R6") - tmp_lib <- tempfile() - dir.create(tmp_lib) + # Exported R6 class methods should be found + expect_true("exported_method" %in% methods) - pkg_dir <- tempfile() - dir.create(file.path(pkg_dir, "R"), recursive = TRUE) - writeLines( - c( - ".onLoad <- function(libname, pkgname) {", - " ns <- asNamespace(pkgname)", - " makeActiveBinding(\"broken\", function() stop(\"boom\"), env = ns)", - "}", - paste0( - "SomeClass <- R6::R6Class(\"SomeClass\", public = list(", - "method = function() \"upstream\"))" - ) - ), - file.path(pkg_dir, "R", "code.R") - ) - writeLines( - c( - "Package: ascribetestbroken", - "Version: 0.0.1", - "Title: Test Helper for Ascribe Broken Namespace Handling", - "Description: Minimal package with an erroring active binding.", - "Author: Ascribe Tests", - "Maintainer: Ascribe Tests ", - "License: MIT", - "Imports: R6" - ), - file.path(pkg_dir, "DESCRIPTION") - ) - writeLines("export(SomeClass)", file.path(pkg_dir, "NAMESPACE")) - - old_lib <- .libPaths() - on.exit( - { - if (isNamespaceLoaded("ascribetestbroken")) { - unloadNamespace("ascribetestbroken") - } - .libPaths(old_lib) - unlink(c(tmp_lib, pkg_dir), recursive = TRUE) - }, - add = TRUE - ) + # Internal/non-exported R6 class methods should also be found + expect_true("internal_method" %in% methods) - .libPaths(c(tmp_lib, old_lib)) - utils::install.packages( - pkg_dir, - repos = NULL, - type = "source", - lib = tmp_lib, - INSTALL_opts = "--no-test-load", - quiet = TRUE - ) + # Returned method names are non-empty and non-NA + expect_false(anyNA(methods)) + expect_true(all(nzchar(methods))) + }) +}) - expect_true("method" %in% collect_r6_methods("ascribetestbroken")) - expect_true("method" %in% collect_pkg_funs("ascribetestbroken")) +test_that("collect_r6_methods survives erroring namespace bindings", { + with_fixtures("ascribetestbroken", function() { + expect_true("method" %in% collect_r6_methods("ascribetestbroken")) + expect_true("method" %in% collect_pkg_funs("ascribetestbroken")) + }) }) test_that("resolve_origin identifies origin of re-exported functions and non-functions", { @@ -116,93 +71,19 @@ test_that("build_origin_map creates pkg::fun keys mapping to origin", { expect_equal(omap[["datasets::iris"]], "datasets") }) - test_that("collect_pkg_funs finds methods of pure re-exported R6 classes", { - skip_if_not_installed("R6") - tmp_lib <- tempfile() - dir.create(tmp_lib) - - up_dir <- tempfile() - dir.create(file.path(up_dir, "R"), recursive = TRUE) - writeLines( - paste0( - "SomeClass <- R6::R6Class(\"SomeClass\", public = list(", - "method = function() \"upstream\"))" - ), - file.path(up_dir, "R", "some_class.R") - ) - writeLines( - c( - "Package: ascribetestupstreamr6", - "Version: 0.0.1", - "Title: Test Helper for Ascribe R6 Re-export Handling", - "Description: Minimal upstream package for testing R6 re-export detection.", - "Author: Ascribe Tests", - "Maintainer: Ascribe Tests ", - "License: MIT", - "Imports: R6" - ), - file.path(up_dir, "DESCRIPTION") - ) - writeLines("export(SomeClass)", file.path(up_dir, "NAMESPACE")) - - down_dir <- tempfile() - dir.create(file.path(down_dir, "R"), recursive = TRUE) - writeLines("NULL", file.path(down_dir, "R", "dummy.R")) - writeLines( - c( - "Package: ascribetestdownstreamr6", - "Version: 0.0.1", - "Title: Test Helper for Ascribe R6 Re-export Handling", - "Description: Minimal downstream package for testing R6 re-export detection.", - "Author: Ascribe Tests", - "Maintainer: Ascribe Tests ", - "License: MIT", - "Imports: ascribetestupstreamr6" - ), - file.path(down_dir, "DESCRIPTION") - ) - writeLines( - c("importFrom(ascribetestupstreamr6, SomeClass)", "export(SomeClass)"), - file.path(down_dir, "NAMESPACE") - ) - - old_lib <- .libPaths() - on.exit( - { - if (isNamespaceLoaded("ascribetestdownstreamr6")) { - unloadNamespace("ascribetestdownstreamr6") - } - if (isNamespaceLoaded("ascribetestupstreamr6")) { - unloadNamespace("ascribetestupstreamr6") - } - .libPaths(old_lib) - unlink(c(tmp_lib, up_dir, down_dir), recursive = TRUE) - }, - add = TRUE - ) - - .libPaths(c(tmp_lib, old_lib)) - utils::install.packages( - up_dir, - repos = NULL, - type = "source", - lib = tmp_lib, - INSTALL_opts = "--no-staged-install", - quiet = TRUE - ) - utils::install.packages( - down_dir, - repos = NULL, - type = "source", - lib = tmp_lib, - INSTALL_opts = "--no-staged-install", - quiet = TRUE + with_fixtures( + c("ascribetestupstreamr6", "ascribetestdownstreamr6"), + function() { + ns <- asNamespace("ascribetestdownstreamr6") + expect_false(exists("ExportedClass", envir = ns, inherits = FALSE)) + + expect_true( + "exported_method" %in% collect_r6_methods("ascribetestdownstreamr6") + ) + expect_true( + "exported_method" %in% collect_pkg_funs("ascribetestdownstreamr6") + ) + } ) - - ns <- asNamespace("ascribetestdownstreamr6") - expect_false(exists("SomeClass", envir = ns, inherits = FALSE)) - - expect_true("method" %in% collect_r6_methods("ascribetestdownstreamr6")) - expect_true("method" %in% collect_pkg_funs("ascribetestdownstreamr6")) }) diff --git a/tests/testthat/test-scan_usage.R b/tests/testthat/test-scan_usage.R index 10e68e7..a749e29 100644 --- a/tests/testthat/test-scan_usage.R +++ b/tests/testthat/test-scan_usage.R @@ -247,10 +247,46 @@ test_that("scan_usage handles metapackages correctly", { ignore_unqualified_functions = character() ) + expect_true("meta_pkg" %in% res$packages) expect_true("real_pkg" %in% res$packages) expect_true("real_pkg::foo" %in% res$functions) }) +test_that("scan_usage metapackage only reports explicitly attached and resolved packages", { + tmp <- tempfile(fileext = ".R") + on.exit(unlink(tmp), add = TRUE) + writeLines( + c( + "library(tidyverse)", + "filter(mtcars, cyl == 4)", + "ggplot2::ggplot(mtcars, aes(mpg, wt))" + ), + tmp + ) + + res <- scan_usage( + path = tmp, + universe = test_universe( + c("dplyr", "ggplot2", "tidyr", "readr"), + list(filter = "dplyr", ggplot = "ggplot2"), + list2env( + list("dplyr::filter" = "dplyr", "ggplot2::ggplot" = "ggplot2"), + parent = emptyenv() + ) + ), + metapackages = list(tidyverse = c("dplyr", "ggplot2", "tidyr", "readr")), + ignore_unqualified_functions = character() + ) + + expect_true("tidyverse" %in% res$packages) + expect_true("dplyr" %in% res$packages) + expect_true("ggplot2" %in% res$packages) + expect_false("tidyr" %in% res$packages) + expect_false("readr" %in% res$packages) + expect_true("dplyr::filter" %in% res$functions) + expect_true("ggplot2::ggplot" %in% res$functions) +}) + test_that("scan_usage handles strict mode on ambiguous calls", { tmp <- tempfile(fileext = ".R") on.exit(unlink(tmp), add = TRUE) @@ -795,7 +831,7 @@ test_that("full coverage tests for all scan_usage.R branches", { expect_equal(cand_res$pkgs, "pkgB") testthat::with_mocked_bindings( - requireNamespace = \(pkg, quietly) FALSE, + requireNamespace = function(pkg, quietly) FALSE, .package = "ascribe", { tmp_rmd <- tempfile(fileext = ".Rmd") diff --git a/vignettes/build-a-citation-scanner.qmd b/vignettes/build-a-citation-scanner.qmd index 59064d1..97b3c8b 100644 --- a/vignettes/build-a-citation-scanner.qmd +++ b/vignettes/build-a-citation-scanner.qmd @@ -13,15 +13,15 @@ library(ascribe) For a complete, real-world implementation of a package citation scanner built with `ascribe`, see [stanflow](https://github.com/VisruthSK/stanflow). -`ascribe` separates AST parsing from citation generation. This guide demonstrates building a citation scanner targeting Stan packages (`cmdstanr`, `posterior`, `bayesplot`, `rstan`). +`ascribe` separates AST parsing from citation generation. This guide demonstrates building a citation scanner targeting base R packages (`stats`, `graphics`, `utils`, `methods`). ## Build the package universe `build_universe_data()` extracts exported functions, R6 methods, and origin mappings for re-exported functions. ```{r} -stan_pkgs <- c("cmdstanr", "posterior", "bayesplot", "rstan") -universe <- build_universe_data(stan_pkgs) +base_pkgs <- c("stats", "graphics", "utils", "methods") +universe <- build_universe_data(base_pkgs) names(universe) ``` @@ -32,18 +32,18 @@ Run `build_universe_data()` in an environment where all target packages are inst `scan_usage()` inspects `.R`, `.Rmd`, and `.qmd` files for package attachments (`library()`, `require()`) and function calls (`pkg::fun()` or unqualified calls resolved by attachment order). ```{r} -project <- tempfile("stan-project-") +project <- tempfile("base-project-") dir.create(project) script <- file.path(project, "analysis.R") writeLines( c( - "library(cmdstanr)", - "library(posterior)", - "fit <- cmdstan_model('model.stan')$sample()", - "draws <- fit$draws()", - "summarise_draws(draws)", - "bayesplot::mcmc_hist(draws)" + "library(stats)", + "library(graphics)", + "fit <- lm(mpg ~ wt, data = mtcars)", + "summary(fit)", + "plot(fit)", + "utils::capture.output(summary(fit))" ), script ) @@ -69,7 +69,7 @@ citations <- cite_usage(usage) writeLines(citations) ``` -Override default package or function citations with `package_citations` and `function_citations`. For the real `Stan` citations, see the `data-raw` directory in [`stanflow`](https://github.com/VisruthSK/stanflow/tree/main/data-raw). +Override default package or function citations with `package_citations` and `function_citations`. ## Save scanner data in sysdata.rda @@ -79,10 +79,10 @@ Override default package or function citations with `package_citations` and `fun #| eval: false # data-raw/sysdata.R generate_universe_sysdata( - packages = c("cmdstanr", "posterior", "bayesplot", "rstan"), - prefix = "stan", + packages = c("stats", "graphics", "utils", "methods"), + prefix = "base", file = "R/sysdata.rda" ) ``` -This saves `.stan_pkgs`, `.stan_exports`, `.stan_export_index`, `.stan_origin_map`, and `.stan_pkg_versions` for fast loading without runtime package inspection. +This saves `.base_pkgs`, `.base_exports`, `.base_export_index`, `.base_origin_map`, and `.base_pkg_versions` for fast loading without runtime package inspection. \ No newline at end of file