aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/packages.scm40
-rw-r--r--tests/packages.scm30
2 files changed, 54 insertions, 16 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 5a280857ea..34222724c0 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -491,21 +491,37 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
#:guile-for-build guile-for-build))))
(define (transitive-inputs inputs)
- (let loop ((inputs inputs)
- (result '()))
+ "Return the closure of INPUTS when considering the 'propagated-inputs'
+edges. Omit duplicate inputs, except for those already present in INPUTS
+itself.
+
+This is implemented as a breadth-first traversal such that INPUTS is
+preserved, and only duplicate propagated inputs are removed."
+ (define (seen? seen item outputs)
+ (match (vhash-assq item seen)
+ ((_ . o) (equal? o outputs))
+ (_ #f)))
+
+ (let loop ((inputs inputs)
+ (result '())
+ (propagated '())
+ (first? #t)
+ (seen vlist-null))
(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)))))
+ (if (null? propagated)
+ (reverse result)
+ (loop (reverse (concatenate propagated)) result '() #f seen)))
+ (((and input (label (? package? package) outputs ...)) rest ...)
+ (if (and (not first?) (seen? seen package outputs))
+ (loop rest result propagated first? seen)
+ (loop rest
+ (cons input result)
+ (cons (package-propagated-inputs package) propagated)
+ first?
+ (vhash-consq package outputs seen))))
((input rest ...)
- (loop rest (cons input result))))))
+ (loop rest (cons input result) propagated first? seen)))))
(define (package-direct-sources package)
"Return all source origins associated with PACKAGE; including origins in
diff --git a/tests/packages.scm b/tests/packages.scm
index 511ad78b6c..3cb532df1a 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -118,10 +118,32 @@
(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"))
+ (equal? `(("b" ,b) ("c" ,c) ("d" ,d)
+ ("a" ,a) ("x" "something.drv"))
(pk 'x (package-transitive-inputs e))))))
+(test-assert "package-transitive-inputs, no duplicates"
+ (let* ((a (dummy-package "a"))
+ (b (dummy-package "b"
+ (inputs `(("a+" ,a)))
+ (native-inputs `(("a*" ,a)))
+ (propagated-inputs `(("a" ,a)))))
+ (c (dummy-package "c"
+ (propagated-inputs `(("b" ,b)))))
+ (d (dummy-package "d"
+ (inputs `(("a" ,a) ("c" ,c)))))
+ (e (dummy-package "e"
+ (inputs `(("b" ,b) ("c" ,c))))))
+ (and (null? (package-transitive-inputs a))
+ (equal? `(("a*" ,a) ("a+" ,a) ("a" ,a)) ;here duplicates are kept
+ (package-transitive-inputs b))
+ (equal? `(("b" ,b) ("a" ,a))
+ (package-transitive-inputs c))
+ (equal? `(("a" ,a) ("c" ,c) ("b" ,b)) ;duplicate A removed
+ (package-transitive-inputs d))
+ (equal? `(("b" ,b) ("c" ,c) ("a" ,a))
+ (package-transitive-inputs e))))) ;ditto
+
(test-equal "package-transitive-supported-systems"
'(("x" "y" "z") ;a
("x" "y") ;b
@@ -573,8 +595,8 @@
(dummy (dummy-package "dummy"
(inputs `(("prop" ,prop)))))
(inputs (bag-transitive-inputs (package->bag dummy #:graft? #f))))
- (match (assoc "prop/dep" inputs)
- (("prop/dep" package)
+ (match (assoc "dep" inputs)
+ (("dep" package)
(eq? package dep)))))
(test-assert "bag->derivation"