diff --git a/R/scan-deps-dep-types.R b/R/scan-deps-dep-types.R index 4caf801f..67a177f4 100644 --- a/R/scan-deps-dep-types.R +++ b/R/scan-deps-dep-types.R @@ -1,6 +1,19 @@ -get_dep_type_from_path <- function(paths) { - type <- rep("prod", length(paths)) - type[paths == "man/roxygen/meta.R"] <- "dev" - type[startsWith(paths, "tests/") | startsWith(paths, "test/")] <- "test" - type +get_dep_type_from_path <- function(paths, orig = NULL) { + tps <- rep("prod", length(paths)) + tps[paths == "man/roxygen/meta.R"] <- "dev" + tps[startsWith(paths, "tests/") | startsWith(paths, "test/")] <- "test" + if (!is.null(orig)) { + # for DESCRIPTION we detect the type from the file itself + dsc <- basename(paths) == "DESCRIPTION" + tps[dsc] <- orig[dsc] + } + tps +} + +get_dep_type_from_description_field <- function(fields) { + tps <- rep("dev", length(fields)) + tps[fields %in% c("Depends", "Imports", "LinkingTo")] <- "prod" + tps[fields %in% c("Suggests", "Enhanced")] <- "test" + tps[fields == "Config/Needs/coverage"] <- "test" + tps } diff --git a/R/scan-deps.R b/R/scan-deps.R index 41c17df0..2988ebf8 100644 --- a/R/scan-deps.R +++ b/R/scan-deps.R @@ -84,12 +84,15 @@ scan_deps <- function(path = ".") { path <- tryCatch(find_project_root(path), error = function(...) path) paths <- dir(path, pattern = "[.](R|r|Rmd|rmd|qmd)$", recursive = TRUE) + if (file.exists(file.path(path, "DESCRIPTION"))) { + paths <- c(paths, "DESCRIPTION") + } 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)) + deps <- do.call("rbind", c(list(scan_deps_df()), deps_list)) # write back the relative paths deps$path <- paths[match(deps$path, full_paths)] - deps$type <- get_dep_type_from_path(deps$path) + deps$type <- get_dep_type_from_path(deps$path, deps$type) class(deps) <- c("pkg_scan_deps", class(deps)) deps } @@ -98,7 +101,7 @@ scan_deps <- function(path = ".") { # needs to increase as the deps discovry code changes, otherwise we don't # apply the new discovery code -deps_cache_version <- 1L +deps_cache_version <- 2L get_deps_cache_path <- function(hash = NULL) { root <- file.path(get_user_cache_dir()$root, "deps", deps_cache_version) @@ -146,20 +149,22 @@ scan_path_deps <- function(path) { deps <- readRDS(cache) if (!is.null(deps) && nrow(deps) > 0) { deps$path <- path - deps$type <- get_dep_type_from_path(path) + deps$type <- get_dep_type_from_path(path, deps$type) } return(deps) } # scan it if it is worth it, based on a quick check - has_deps <- length(grepRaw(re_r_dep(), code)) > 0 - deps <- if (has_deps) scan_path_deps_do(code, path) + maybe_has_deps <- file_extx(path) != "r" || + length(grepRaw(re_r_dep(), code)) > 0 + deps <- if (maybe_has_deps) { + scan_path_deps_do(code, path) + } # save it to the cache, but anonimize it first. If no deps, save NULL deps_no_path <- deps if (!is.null(deps_no_path) && nrow(deps_no_path) > 0) { deps_no_path$path <- "" - deps_no_path$type <- NA_character_ } dir.create(dirname(cache), showWarnings = FALSE, recursive = TRUE) saveRDS(deps_no_path, cache) @@ -167,25 +172,38 @@ scan_path_deps <- function(path) { deps } -scan_path_deps_empty <- function() { +scan_deps_df <- function( + path = character(), + ref = package, + package = character(), + version = "*", + type = get_dep_type_from_path(path), + code = character(), + start_row = 1L, + start_column = 1L, + start_byte = 1L +) { data_frame( - path = character(), - package = character(), - type = character(), - code = character(), - start_row = integer(), - start_column = integer(), - start_byte = integer() + path = path, + ref = ref, + package = package, + version = version, + type = type, + code = code, + start_row = start_row, + start_column = start_column, + start_byte = start_byte ) } scan_path_deps_do <- function(code, path) { - ext <- tolower(file_ext(path)) + ext <- file_extx(path) switch( ext, ".r" = scan_path_deps_do_r(code, path), ".qmd" = , ".rmd" = scan_path_deps_do_rmd(code, path), + "DESCRIPTION" = scan_path_deps_do_dsc(code, path), stop("Cannot parse ", ext, " file for dependencies, internal error") ) } @@ -232,10 +250,10 @@ scan_path_deps_do_r <- function(code, path, ranges = NULL) { } scan_path_deps_do_pkg_hits <- function(hits, path) { - data_frame( + pkg <- hits$code[hits$name == "pkg-name"] + scan_deps_df( path = path, - package = hits$code[hits$name == "pkg-name"], - type = get_dep_type_from_path(path), + package = pkg, code = hits$code[hits$name == "dep-code"], start_row = hits$start_row[hits$name == "dep-code"], start_column = hits$start_column[hits$name == "dep-code"], @@ -246,10 +264,9 @@ scan_path_deps_do_pkg_hits <- function(hits, path) { scan_path_deps_do_fn_hits <- function(hits, path) { fn_pkg_map <- c(setClass = "methods", setGeneric = "methods") fn_names <- hits$code[hits$name == "fn-name"] - data_frame( + scan_deps_df( path = path, package = fn_pkg_map[fn_names], - type = get_dep_type_from_path(path), code = hits$code[hits$name == "dep-code"], start_row = hits$start_row[hits$name == "dep-code"], start_column = hits$start_column[hits$name == "dep-code"], @@ -271,10 +288,9 @@ scan_path_deps_do_gen_hits <- function(hits, path) { safe_parse_pkg_from_call(ns[i], fn[i], code[i]) }) pkgs_count <- lengths(pkgs) - data_frame( + scan_deps_df( path = path, package = unlist(pkgs), - type = get_dep_type_from_path(path), code = rep(code, pkgs_count), start_row = rep(hits$start_row[hits$name == "dep-code"], pkgs_count), start_column = rep(hits$start_column[hits$name == "dep-code"], pkgs_count), @@ -284,10 +300,9 @@ 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( + scan_deps_df( 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"], @@ -302,10 +317,9 @@ scan_pat_deps_do_ragg_hits <- function(hits, path) { matched <- match.call(function(...) { }, expr, expand.dots=FALSE) args <- matched[["..."]] if ("dev" %in% names(args) && args[["dev"]] == "ragg_png") { - return(data_frame( + return(scan_deps_df( path = path, package = "ragg", - type = get_dep_type_from_path(path), code = hits$code[wc], start_row = hits$start_row[wc], start_column = hits$start_column[wc], @@ -321,10 +335,9 @@ scan_pat_deps_do_db_hits <- function(hits, path) { fns <- unlist(lapply(db, names)) map <- unlist(unname(db), recursive = FALSE) pkgs <- unlist(map[hits$code]) - data_frame( + scan_deps_df( path = path, package = pkgs, - type = get_dep_type_from_path(path), code = hits$code, start_row = hits$start_row, start_column = hits$start_column, @@ -792,10 +805,9 @@ scan_path_deps_do_header_shiny_hits <- function(code, hits, path) { hits <- hits[hits$name == "value", ] vals <- yaml_parse_scalar(hits$code) shiny <- vals == "shiny" - data_frame( + scan_deps_df( path = path, package = "shiny", - type = get_dep_type_from_path(path), code = hits$code[shiny], start_row = hits$start_row[shiny], start_column = hits$start_column[shiny], @@ -820,10 +832,9 @@ scan_path_deps_do_header_pkgstr_hits <- function(code, hits, path) { if (all(is.na(pkg))) return(NULL) hits <- hits[!is.na(pkg), ] pkg <- na.omit(pkg) - data_frame( + scan_deps_df( path = path, package = pkg, - type = get_dep_type_from_path(path), code = hits$code, start_row = hits$start_row, start_column = hits$start_column, @@ -832,10 +843,9 @@ scan_path_deps_do_header_pkgstr_hits <- function(code, hits, path) { } scan_path_deps_do_header_bslib_hits <- function(code, hits, path) { - data_frame( + scan_deps_df( path = path, package = "bslib", - type = get_dep_type_from_path(path), code = hits$code[hits$name == "code"], start_row = hits$start_row[hits$name == "code"], start_column = hits$start_column[hits$name == "code"], @@ -864,3 +874,25 @@ scan_path_deps_do_header_tag_hits <- function(code, hits, path) { yaml_parse_scalar <- function(x) { vcapply(x, function(x) .Call(c_yaml_parse_scalar, x), USE.NAMES = FALSE) } + +# ------------------------------------------------------------------------- + +scan_path_deps_do_dsc <- function(code, path) { + code <- if (is.raw(code)) rawToChar(code) + dsc <- desc::desc(text = code) + deps <- resolve_ref_deps( + dsc$get_deps(), + dsc$get("Remotes")[[1]], + dsc$get(extra_config_fields(dsc$fields())) + ) + deps <- deps[deps$package != "R", ] + version <- ifelse(deps$op == "", "*", paste0(deps$op, deps$version)) + scan_deps_df( + path = path, + ref = deps$ref, + package = deps$package, + version = version, + type = get_dep_type_from_description_field(deps$type), + code = deps$ref + ) +} diff --git a/R/utils.R b/R/utils.R index c6a05665..7753e3fd 100644 --- a/R/utils.R +++ b/R/utils.R @@ -510,6 +510,11 @@ file_ext <- function(x) { re_match(x, "[.]([[:alnum:]]+)$")[[".match"]] } +file_extx <- function(x) { + ext <- tolower(file_ext(x)) + ifelse(is.na(ext), basename(x), ext) +} + # drop a prefix and a postfix, vectorized omit_pre_post <- function(x, pre = 0, post = 0) { substr(x, 1L + pre, nchar(x) - post) diff --git a/tests/testthat/_snaps/scan-deps.md b/tests/testthat/_snaps/scan-deps.md index 9d64e1cc..9c5ccea7 100644 --- a/tests/testthat/_snaps/scan-deps.md +++ b/tests/testthat/_snaps/scan-deps.md @@ -3,18 +3,18 @@ Code writeLines(get_deps_cache_path()) Output - //R/pkgcache/deps/1 + //R/pkgcache/deps/2 Code writeLines(get_deps_cache_path("badcafe")) Output - //R/pkgcache/deps/1/ba/badcafe + //R/pkgcache/deps/2/ba/badcafe # clear_deps_cache Code dir(tmp, recursive = TRUE) Output - [1] "R/pkgcache/deps/1/ba/badcafe" + [1] "R/pkgcache/deps/2/ba/badcafe" --- @@ -30,26 +30,27 @@ 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 +# scan_deps_df Code - scan_path_deps_empty() + scan_deps_df() Output - # A data frame: 0 x 7 - # i 7 variables: path , package , type , code , - # start_row , start_column , start_byte + # A data frame: 0 x 9 + # i 9 variables: path , ref , package , version , + # 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 + # A data frame: 3 x 9 + path ref package version type code start_row start_column start_byte + + 1 code.R CD CD * prod CD::pkg 4 1 26 + 2 code.R AB AB * prod library(~ 1 1 1 + 3 code.R BC BC * prod require(~ 2 1 13 --- @@ -64,60 +65,60 @@ 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 + # A data frame: 3 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/project-1/R/code.R CD CD * prod CD::pkg 4 1 26 + 2 fixtures/scan/project-1/R/code.R AB AB * prod library(AB) 1 1 1 + 3 fixtures/scan/project-1/R/code.R BC 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 + # A data frame: 2 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/methods.R methods methods * prod "setClass(\"track\", slots = c(x=\"numeric\", y=\"numeric\"))" 2 10 43 + 2 fixtures/scan/methods.R methods 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 + # A data frame: 6 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/junit.R testthat testthat * prod testthat::JunitReporter 1 8 8 + 2 fixtures/scan/junit.R testthat testthat * prod library(testthat) 3 1 39 + 3 fixtures/scan/junit.R xml2 xml2 * prod testthat::JunitReporter$new() 1 8 8 + 4 fixtures/scan/junit.R xml2 xml2 * prod JunitReporter$new() 5 9 66 + 5 fixtures/scan/junit.R xml2 xml2 * prod JunitReporter 1 18 18 + 6 fixtures/scan/junit.R xml2 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 + # A data frame: 3 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/knitr.Rmd knitr knitr * prod "knitr::opts_chunk" 3 1 9 + 2 fixtures/scan/knitr.Rmd knitr knitr * prod "knitr::opts_chunk" 7 1 61 + 3 fixtures/scan/knitr.Rmd ragg 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 + # A data frame: 1 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/noragg.Rmd knitr knitr * prod knitr::opts_chunk 2 1 8 # safe_parse_pkg_from_call @@ -247,22 +248,22 @@ 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 + # A data frame: 1 x 9 + path ref package version type code start_row start_column start_byte + + 1 chunk-errors.Rmd dplyr 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 + # A data frame: 3 x 9 + path ref package version type code start_row start_column start_byte + + 1 inline-chunks.Rmd inline inline * prod inline::chunks 4 49 68 + 2 inline-chunks.Rmd multiple multiple * prod multiple::calls 4 92 111 + 3 inline-chunks.Rmd separate separate * prod separate::chunks 6 12 160 # scan_path_deps_do_rmd #3 @@ -276,45 +277,65 @@ Code scan_path_deps_do_rmd(readLines(path), basename(path)) Output - # A data frame: 2 x 7 - path package type code start_row start_column start_byte - - 1 header.Rmd p1 prod p1::fun 4 14 32 - 2 header.Rmd p2 prod library(p2) 7 14 81 + # A data frame: 2 x 9 + path ref package version type code start_row start_column start_byte + + 1 header.Rmd p1 p1 * prod p1::fun 4 14 32 + 2 header.Rmd p2 p2 * prod library(p2) 7 14 81 # scan_path_deps_do_header_shiny_hits Code scan_path_deps_do_rmd(readLines(path), basename(path)) Output - # A data frame: 4 x 7 - path package type code start_row start_column start_byte - - 1 header-shiny.Rmd shiny prod "shiny" 4 11 26 - 2 header-shiny.Rmd shiny prod "'shiny'" 5 9 40 - 3 header-shiny.Rmd shiny prod "\"shiny\"" 6 11 58 - 4 header-shiny.Rmd shiny prod "|\n shiny" 7 9 74 + # A data frame: 4 x 9 + path ref package version type code start_row start_column start_byte + + 1 header-shiny.Rmd shiny shiny * prod "shiny" 4 11 26 + 2 header-shiny.Rmd shiny shiny * prod "'shiny'" 5 9 40 + 3 header-shiny.Rmd shiny shiny * prod "\"shiny\"" 6 11 58 + 4 header-shiny.Rmd shiny shiny * prod "|\n shiny" 7 9 74 --- Code scan_path_deps_do_rmd(readLines(path), basename(path)) Output - # A data frame: 4 x 7 - path package type code start_row start_column start_byte - - 1 header-shiny2.Rmd shiny prod "shiny" 5 9 32 - 2 header-shiny2.Rmd shiny prod "'shiny'" 7 9 56 - 3 header-shiny2.Rmd shiny prod "\"shiny\"" 9 11 82 - 4 header-shiny2.Rmd shiny prod ">\n shiny" 11 9 106 + # A data frame: 4 x 9 + path ref package version type code start_row start_column start_byte + + 1 header-shiny2.Rmd shiny shiny * prod "shiny" 5 9 32 + 2 header-shiny2.Rmd shiny shiny * prod "'shiny'" 7 9 56 + 3 header-shiny2.Rmd shiny shiny * prod "\"shiny\"" 9 11 82 + 4 header-shiny2.Rmd shiny shiny * prod ">\n shiny" 11 9 106 # scan_path_deps_do_header_bslib_hits Code scan_path_deps_do_rmd(readLines(path), basename(path)) Output - # A data frame: 1 x 7 - path package type code start_row start_column start_byte - - 1 header-bslib.Rmd bslib prod "output:\n html_document:\n toc: true\n theme: some theme" 4 1 16 + # A data frame: 1 x 9 + path ref package version type code start_row start_column start_byte + + 1 header-bslib.Rmd bslib bslib * prod "output:\n html_document:\n toc: true\n theme: some theme" 4 1 16 + +# scan_path_deps_do_dsc + + Code + scan_path_deps_do_dsc(readLines(path), basename(path)) + Output + # A data frame: 42 x 9 + path ref package version type code start_row start_column start_byte + + 1 DESCRIPTION callr callr >=3.3.1 prod callr 1 1 1 + 2 DESCRIPTION r-lib/cli cli >=3.6.0 prod r-lib/cli 1 1 1 + 3 DESCRIPTION curl curl * prod curl 1 1 1 + 4 DESCRIPTION desc desc >=1.4.3 prod desc 1 1 1 + 5 DESCRIPTION filelock filelock >=1.0.2 prod filelock 1 1 1 + 6 DESCRIPTION jsonlite jsonlite * prod jsonlite 1 1 1 + 7 DESCRIPTION lpSolve lpSolve * prod lpSolve 1 1 1 + 8 DESCRIPTION pkgbuild pkgbuild >=1.0.2 prod pkgbuild 1 1 1 + 9 DESCRIPTION pkgcache pkgcache >=2.2.0 prod pkgcache 1 1 1 + 10 DESCRIPTION processx processx >=3.4.2 prod processx 1 1 1 + # i 32 more rows diff --git a/tests/testthat/_snaps/unix/scan-deps.md b/tests/testthat/_snaps/unix/scan-deps.md index cf2f3ed5..1b718566 100644 --- a/tests/testthat/_snaps/unix/scan-deps.md +++ b/tests/testthat/_snaps/unix/scan-deps.md @@ -3,15 +3,15 @@ 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 + # A data frame: 6 x 9 + path ref package version type code start_row start_column start_byte + + 1 R/code.R CD CD * prod CD::pkg 4 1 26 + 2 R/code.R AB AB * prod library(AB) 1 1 1 + 3 R/code.R BC BC * prod require(BC) 2 1 13 + 4 doc.qmd pkgload pkgload * prod pkgload::load_all 12 1 174 + 5 index.Rmd ST ST * prod ST::fun 10 1 97 + 6 index.Rmd RS RS * prod library(RS) 9 1 85 --- @@ -32,22 +32,22 @@ 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 + # A data frame: 3 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/project-1/R/code.R CD CD * prod CD::pkg 4 1 26 + 2 fixtures/scan/project-1/R/code.R AB AB * prod library(AB) 1 1 1 + 3 fixtures/scan/project-1/R/code.R BC 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 + # A data frame: 3 x 9 + path ref package version type code start_row start_column start_byte + + 1 fixtures/scan/project-1/R/code.R CD CD * prod CD::pkg 4 1 26 + 2 fixtures/scan/project-1/R/code.R AB AB * prod library(AB) 1 1 1 + 3 fixtures/scan/project-1/R/code.R BC BC * prod require(BC) 2 1 13 diff --git a/tests/testthat/fixtures/scan/DESCRIPTION b/tests/testthat/fixtures/scan/DESCRIPTION new file mode 100644 index 00000000..dee4e6fa --- /dev/null +++ b/tests/testthat/fixtures/scan/DESCRIPTION @@ -0,0 +1,75 @@ +Package: pkgdepends +Title: Package Dependency Resolution and Downloads +Version: 0.8.0.9000 +Authors@R: c( + person("Gábor", "Csárdi", , "csardi.gabor@gmail.com", role = c("aut", "cre")), + person("Posit Software, PBC", role = c("cph", "fnd")) + ) +Description: Find recursive dependencies of 'R' packages from various + sources. Solve the dependencies to obtain a consistent set of packages + to install. Download packages, and install them. It supports packages + on 'CRAN', 'Bioconductor' and other 'CRAN-like' repositories, + 'GitHub', package 'URLs', and local package trees and files. It caches + metadata and package files via the 'pkgcache' package, and performs + all 'HTTP' requests, downloads, builds and installations in parallel. + 'pkgdepends' is the workhorse of the 'pak' package. +License: MIT + file LICENSE +URL: https://r-lib.github.io/pkgdepends/, + https://github.com/r-lib/pkgdepends +BugReports: https://github.com/r-lib/pkgdepends/issues +Depends: + R (>= 3.5) +Imports: + callr (>= 3.3.1), + cli (>= 3.6.0), + curl, + desc (>= 1.4.3), + filelock (>= 1.0.2), + jsonlite, + lpSolve, + pkgbuild (>= 1.0.2), + pkgcache (>= 2.2.0), + processx (>= 3.4.2), + ps, + R6, + stats, + utils, + zip (>= 2.3.0) +Suggests: + asciicast (>= 2.2.0.9000), + codetools, + covr, + debugme, + fansi, + fs, + gh, + gitcreds, + glue, + htmlwidgets, + mockery, + pak, + pingr (>= 2.0.0), + rmarkdown, + rstudioapi, + spelling, + svglite, + testthat (>= 3.2.0), + tibble, + webfakes (>= 1.1.5.9000), + withr (>= 2.1.1), +Config/Needs/builder: + gh, + pkgsearch, + withr (>= 2.1.1) +Config/Needs/coverage: + r-lib/asciicast, + covr +Config/Needs/website: + r-lib/asciicast, + pkgdown (>= 2.0.2), + tidyverse/tidytemplate +Remotes: + r-lib/cli +Config/testthat/edition: 3 +Encoding: UTF-8 +RoxygenNote: 7.3.2 diff --git a/tests/testthat/test-scan-deps.R b/tests/testthat/test-scan-deps.R index fa0a95c5..32d21235 100644 --- a/tests/testthat/test-scan-deps.R +++ b/tests/testthat/test-scan-deps.R @@ -65,9 +65,9 @@ test_that("scan_path_deps", { }) }) -test_that("scan_path_deps_empty", { +test_that("scan_deps_df", { expect_snapshot({ - scan_path_deps_empty() + scan_deps_df() }) }) @@ -464,3 +464,11 @@ test_that("scan_path_deps_do_header_bslib_hits", { scan_path_deps_do_rmd(readLines(path), basename(path)) }) }) + +test_that("scan_path_deps_do_dsc", { + local_reproducible_output(width = 500) + path <- test_path("fixtures/scan/DESCRIPTION") + expect_snapshot({ + scan_path_deps_do_dsc(readLines(path), basename(path)) + }) +})