diff options
| -rw-r--r-- | guix/packages.scm | 40 | ||||
| -rw-r--r-- | tests/packages.scm | 30 |
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" |