diff options
author | Ludovic Courtès <ludo@gnu.org> | 2012-07-07 20:14:20 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2012-07-07 20:14:31 +0200 |
commit | a3d73f59e35e19561afde1bf60ef881a4e8db0e7 (patch) | |
tree | 5ef1d41fdae49ba439d3e10ae615f69abba45e6e | |
parent | d5f0c7cc626a0517237c55848342777623d1bd01 (diff) | |
download | guix-a3d73f59e35e19561afde1bf60ef881a4e8db0e7.tar.gz guix-a3d73f59e35e19561afde1bf60ef881a4e8db0e7.zip |
Add `package-transitive-inputs'; use it to honor propagated inputs.
* guix/packages.scm (package-transitive-inputs): New procedure.
(package-derivation): Use it to compute INPUTS.
* tests/packages.scm (dummy-package): New macro.
("package-transitive-inputs"): New test.
-rw-r--r-- | guix/packages.scm | 25 | ||||
-rw-r--r-- | tests/packages.scm | 28 |
2 files changed, 51 insertions, 2 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 2d269ad339..c835e92815 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -57,6 +57,7 @@ package-properties package-location + package-transitive-inputs package-source-derivation package-derivation package-cross-derivation)) @@ -161,6 +162,27 @@ representation." (($ <origin> uri method sha256 name) (method store uri 'sha256 sha256 name)))) +(define (package-transitive-inputs package) + "Return the transitive inputs of PACKAGE---i.e., its direct inputs along +with their propagated inputs, recursively." + (let loop ((inputs (concatenate (list (package-native-inputs package) + (package-inputs package) + (package-propagated-inputs package)))) + (result '())) + (match inputs + (() + (delete-duplicates (reverse result))) ; XXX: efficiency + (((and i (name (? package? p) sub ...)) rest ...) + (let ((t (map (match-lambda + ((dep-name derivation ...) + (cons (string-append name "/" dep-name) + derivation))) + (package-propagated-inputs p)))) + (loop (append t rest) + (append t (cons i result))))) + ((input rest ...) + (loop rest (cons input result)))))) + (define* (package-derivation store package #:optional (system (%current-system))) "Return the derivation of PACKAGE for SYSTEM." @@ -186,8 +208,7 @@ representation." (list name (add-to-store store (basename file) #t #f "sha256" file)))) - (concatenate (list native-inputs inputs - propagated-inputs))))) + (package-transitive-inputs package)))) (apply builder store (string-append name "-" version) (package-source-derivation store source) diff --git a/tests/packages.scm b/tests/packages.scm index eef7d32a35..d804e0ce83 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -22,6 +22,7 @@ #:use-module (guix utils) #:use-module (guix derivations) #:use-module (guix packages) + #:use-module (guix build-system gnu) #:use-module (distro) #:use-module (distro base) #:use-module (srfi srfi-26) @@ -35,6 +36,32 @@ (test-begin "packages") +(define-syntax-rule (dummy-package name* extra-fields ...) + (package (name name*) (version "0") (source #f) + (build-system gnu-build-system) + (description #f) (long-description #f) + (home-page #f) + extra-fields ...)) + +(test-assert "package-transitive-inputs" + (let* ((a (dummy-package "a")) + (b (dummy-package "b" + (propagated-inputs `(("a" ,a))))) + (c (dummy-package "c" + (inputs `(("a" ,a))))) + (d (dummy-package "d" + (propagated-inputs `(("x" "something.drv"))))) + (e (dummy-package "e" + (inputs `(("b" ,b) ("c" ,c) ("d" ,d)))))) + (and (null? (package-transitive-inputs a)) + (equal? `(("a" ,a)) (package-transitive-inputs b)) + (equal? `(("a" ,a)) (package-transitive-inputs c)) + (equal? (package-propagated-inputs d) + (package-transitive-inputs d)) + (equal? `(("b" ,b) ("b/a" ,a) ("c" ,c) + ("d" ,d) ("d/x" "something.drv")) + (pk 'x (package-transitive-inputs e)))))) + (test-skip (if (not %store) 1 0)) (test-assert "GNU Hello" @@ -63,4 +90,5 @@ ;;; Local Variables: ;;; eval: (put 'test-assert 'scheme-indent-function 1) +;;; eval: (put 'dummy-package 'scheme-indent-function 1) ;;; End: |