tribes/guix-fork
1
0
Fork 0
forked from tribes/guix
Code Pull Requests Activity

import/cran: Detect test and vignette inputs.

Browse Source 
* guix/import/cran.scm (import-pattern): New variable.
(needed-test-inputs-in-directory, needed-vignettes-inputs-in-directory): New
procedures.
(source-dir->dependencies): Add native inputs from result of
NEEDED-TEST-INPUTS-IN-DIRECTORY and NEEDED-VIGNETTES-INPUTS-IN-DIRECTORY.
(cran-package-inputs): Clean up and delete duplicates from source-derived
inputs.

Change-Id: Id139c144fc6e866e4aaf8f05201b0d2687744fb6
This commit is contained in:
Ricardo Wurmus
2024-11-27 14:11:18 +01:00
parent 4a06a1aca3
commit eac2074a6d
1 changed files with 123 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files
guix/import/cran.scm
+123 -15
View File
@@ -23,6 +23,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import cran)
#:use-module (ice-9 ftw)
#:use-module (ice-9 match)
#:use-module (ice-9 regex)
#:use-module (ice-9 popen)
@@ -551,6 +552,90 @@ referenced in build system files."
(set)
(find-files dir "(Makevars(.in.*)?|configure.*)"))))
;; A pattern matching "library" or "require" statements, capturing the first
;; argument.
(define import-pattern
(make-regexp "^ *(require|library)\\(\"?([^, \")]+)"))
(define (needed-test-inputs-in-directory dir)
"Return a set of R package names that are found in library import
statements in files in the directory DIR."
(if (getenv "GUIX_CRAN_IGNORE_TEST_INPUTS")
(set)
(match (scandir dir (negate (cute member <> '("." ".."))))
((package-directory-name . rest)
(let* ((test-directories
(filter file-exists?
(list (string-append dir "/" package-directory-name "/tests")
(string-append dir "/" package-directory-name "/Tests")
(string-append dir "/" package-directory-name "/inst/unitTests")
(string-append dir "/" package-directory-name "/inst/UnitTests"))))
(imported-packages
(fold (lambda (file packages)
(call-with-input-file file
(lambda (port)
(let loop ((packages packages))
(let ((line (read-line port)))
(cond
((eof-object? line) packages)
(else
(loop
(fold (lambda (match acc)
(let ((imported (match:substring match 2)))
(if (or (string=? imported package-directory-name)
(member imported default-r-packages))
acc
(set-insert imported acc))))
packages
(list-matches import-pattern line))))))))))
(set)
(append-map (lambda (directory)
(find-files directory "\\.(R|Rmd)"))
test-directories))))
;; Special case for BiocGenerics + RUnit.
(if (any (lambda (directory)
(files-match-pattern? directory "BiocGenerics:::testPackage"
"\\.R"))
test-directories)
(set-insert "RUnit"
(set-insert "BiocGenerics" imported-packages))
imported-packages)))
(_ (set)))))
(define (needed-vignettes-inputs-in-directory dir)
"Return a set of R package names that are found in library import statements
in vignette files in the directory DIR."
(if (getenv "GUIX_CRAN_IGNORE_VIGNETTE_INPUTS")
(set)
(match (scandir dir (negate (cute member <> '("." ".."))))
((package-directory-name . rest)
(let ((vignettes-directories
(filter file-exists?
(list (string-append dir "/" package-directory-name "/vignettes")))))
(fold (lambda (file packages)
(call-with-input-file file
(lambda (port)
(let loop ((packages packages))
(let ((line (read-line port)))
(cond
((eof-object? line) packages)
(else
(loop
(fold (lambda (match acc)
(let ((imported (match:substring match 2)))
(if (or (string=? imported package-directory-name)
(member imported default-r-packages))
acc
(set-insert imported acc))))
packages
(list-matches import-pattern line))))))))))
(set)
(append-map (lambda (directory)
(find-files directory "\\.Rnw"))
vignettes-directories))))
(_ (set)))))
(define (directory-needs-pkg-config? dir)
"Return #T if any of the Makevars files in the src directory DIR reference
the pkg-config tool."
@@ -572,6 +657,14 @@ in DIR."
(name name)
(downstream-name name)))
(needed-libraries-in-directory dir))
(map (lambda (name)
(upstream-input
(name name)
(downstream-name (cran-guix-name name))
(type 'native)))
(set->list
(set-union (needed-test-inputs-in-directory dir)
(needed-vignettes-inputs-in-directory dir))))
(if (directory-needs-esbuild? dir)
(list (native "esbuild"))
'())
@@ -653,25 +746,40 @@ of META, a package in REPOSITORY."
((assoc-ref meta 'hg) 'hg)
(else #f))))
(tarball? (not (or (assoc-ref meta 'git)
(assoc-ref meta 'hg)))))
(assoc-ref meta 'hg))))
(compare-upstream-inputs
(lambda (input1 input2)
(string<? (upstream-input-downstream-name input1)
(upstream-input-downstream-name input2))))
(upstream-inputs-equal?
(lambda (input1 input2)
(string=? (upstream-input-downstream-name input1)
(upstream-input-downstream-name input2))))
(r-inputs
(append (cran-package-propagated-inputs meta)
(vignette-builders meta)))
(source-derived-inputs
;; Only keep new inputs
(lset-difference upstream-inputs-equal?
(source->dependencies source tarball?)
r-inputs))
(system-inputs
(filter-map (lambda (name)
(and (not (member name invalid-packages))
(upstream-input
(name name)
(downstream-name
(transform-sysname name)))))
(map string-downcase
(listify meta "SystemRequirements")))))
(sort (filter
;; Prevent tight cycles.
(lambda (input)
((negate string=?) name (upstream-input-name input)))
(append (source->dependencies source tarball?)
(filter-map (lambda (name)
(and (not (member name invalid-packages))
(upstream-input
(name name)
(downstream-name
(transform-sysname name)))))
(map string-downcase
(listify meta "SystemRequirements")))
(cran-package-propagated-inputs meta)
(vignette-builders meta)))
(lambda (input1 input2)
(string<? (upstream-input-downstream-name input1)
(upstream-input-downstream-name input2))))))
(append source-derived-inputs
system-inputs
r-inputs))
compare-upstream-inputs)))
(define (phases-for-inputs input-names)
"Generate a list of build phases based on the provided INPUT-NAMES, a list