aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/packages.scm25
-rw-r--r--tests/packages.scm28
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: