From b68be9d90c03819812cc875bb3e89c180edd669c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= <csardi.gabor@gmail.com>
Date: Sat, 14 Dec 2024 23:52:10 +0100
Subject: [PATCH] scan_deps() scans DESCRIPTION as well (#401)

---
 R/scan-deps-dep-types.R                  |  23 ++-
 R/scan-deps.R                            | 102 ++++++++-----
 R/utils.R                                |   5 +
 tests/testthat/_snaps/scan-deps.md       | 175 +++++++++++++----------
 tests/testthat/_snaps/unix/scan-deps.md  |  42 +++---
 tests/testthat/fixtures/scan/DESCRIPTION |  75 ++++++++++
 tests/testthat/test-scan-deps.R          |  12 +-
 7 files changed, 294 insertions(+), 140 deletions(-)
 create mode 100644 tests/testthat/fixtures/scan/DESCRIPTION

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
-      <tempdir>/<tempfile>/R/pkgcache/deps/1
+      <tempdir>/<tempfile>/R/pkgcache/deps/2
     Code
       writeLines(get_deps_cache_path("badcafe"))
     Output
-      <tempdir>/<tempfile>/R/pkgcache/deps/1/ba/badcafe
+      <tempdir>/<tempfile>/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 <chr>, package <chr>, type <chr>, code <chr>,
-      #   start_row <int>, start_column <int>, start_byte <int>
+      # A data frame: 0 x 9
+      # i 9 variables: path <chr>, ref <chr>, package <chr>, version <chr>,
+      #   type <chr>, code <chr>, start_row <int>, start_column <int>,
+      #   start_byte <int>
 
 # 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
-        <chr>  <chr>   <chr> <chr>           <int>        <int>      <int>
-      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
+        <chr>  <chr> <chr>   <chr>   <chr> <chr>         <int>        <int>      <int>
+      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
-        <chr>                            <chr>   <chr> <chr>           <int>        <int>      <int>
-      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
+        <chr>                            <chr> <chr>   <chr>   <chr> <chr>           <int>        <int>      <int>
+      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
-        <chr>                   <chr>   <chr> <chr>                                                              <int>        <int>      <int>
-      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
+        <chr>                   <chr>   <chr>   <chr>   <chr> <chr>                                                              <int>        <int>      <int>
+      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
-        <chr>                 <chr>    <chr> <chr>                             <int>        <int>      <int>
-      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
+        <chr>                 <chr>    <chr>    <chr>   <chr> <chr>                             <int>        <int>      <int>
+      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
-        <chr>                   <chr>   <chr> <chr>                                           <int>        <int>      <int>
-      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
+        <chr>                   <chr> <chr>   <chr>   <chr> <chr>                                           <int>        <int>      <int>
+      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
-        <chr>                    <chr>   <chr> <chr>                 <int>        <int>      <int>
-      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
+        <chr>                    <chr> <chr>   <chr>   <chr> <chr>                 <int>        <int>      <int>
+      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
-        <chr>            <chr>   <chr> <chr>              <int>        <int>      <int>
-      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
+        <chr>            <chr> <chr>   <chr>   <chr> <chr>              <int>        <int>      <int>
+      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
-        <chr>             <chr>    <chr> <chr>                <int>        <int>      <int>
-      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
+        <chr>             <chr>    <chr>    <chr>   <chr> <chr>                <int>        <int>      <int>
+      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
-        <chr>      <chr>   <chr> <chr>           <int>        <int>      <int>
-      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
+        <chr>      <chr> <chr>   <chr>   <chr> <chr>           <int>        <int>      <int>
+      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
-        <chr>            <chr>   <chr> <chr>            <int>        <int>      <int>
-      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
+        <chr>            <chr> <chr>   <chr>   <chr> <chr>            <int>        <int>      <int>
+      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
-        <chr>             <chr>   <chr> <chr>              <int>        <int>      <int>
-      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
+        <chr>             <chr> <chr>   <chr>   <chr> <chr>              <int>        <int>      <int>
+      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
-        <chr>            <chr>   <chr> <chr>                                                                 <int>        <int>      <int>
-      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
+        <chr>            <chr> <chr>   <chr>   <chr> <chr>                                                                 <int>        <int>      <int>
+      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
+         <chr>       <chr>     <chr>    <chr>   <chr> <chr>         <int>        <int>      <int>
+       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
-        <chr>     <chr>   <chr> <chr>                 <int>        <int>      <int>
-      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
+        <chr>     <chr>   <chr>   <chr>   <chr> <chr>                 <int>        <int>      <int>
+      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
-        <chr>                            <chr>   <chr> <chr>           <int>        <int>      <int>
-      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
+        <chr>                            <chr> <chr>   <chr>   <chr> <chr>           <int>        <int>      <int>
+      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
-        <chr>                            <chr>   <chr> <chr>           <int>        <int>      <int>
-      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
+        <chr>                            <chr> <chr>   <chr>   <chr> <chr>           <int>        <int>      <int>
+      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))
+  })
+})