packages: 'fold-bag-dependencies' honors nativeness in recursive calls.

Previously recursive calls to 'loop' would always consider all the bag
inputs rather than those corresponding to NATIVE?.

* guix/packages.scm (fold-bag-dependencies)[bag-direct-inputs*]: New
procedure.  Use it both in the 'match' expression and in its body.
This commit is contained in:
Ludovic Courtès 2017-12-05 15:13:38 +01:00
parent f00b85ff8d
commit ff0e0041f3
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

View File

@ -996,14 +996,18 @@ and return it."
"Fold PROC over the packages BAG depends on. Each package is visited only "Fold PROC over the packages BAG depends on. Each package is visited only
once, in depth-first order. If NATIVE? is true, restrict to native once, in depth-first order. If NATIVE? is true, restrict to native
dependencies; otherwise, restrict to target dependencies." dependencies; otherwise, restrict to target dependencies."
(define bag-direct-inputs*
(if native?
(lambda (bag)
(append (bag-build-inputs bag)
(bag-target-inputs bag)
(if (bag-target bag)
'()
(bag-host-inputs bag))))
bag-host-inputs))
(define nodes (define nodes
(match (if native? (match (bag-direct-inputs* bag)
(append (bag-build-inputs bag)
(bag-target-inputs bag)
(if (bag-target bag)
'()
(bag-host-inputs bag)))
(bag-host-inputs bag))
(((labels things _ ...) ...) (((labels things _ ...) ...)
things))) things)))
@ -1016,7 +1020,7 @@ dependencies; otherwise, restrict to target dependencies."
(((? package? head) . tail) (((? package? head) . tail)
(if (set-contains? visited head) (if (set-contains? visited head)
(loop tail result visited) (loop tail result visited)
(let ((inputs (bag-direct-inputs (package->bag head)))) (let ((inputs (bag-direct-inputs* (package->bag head))))
(loop (match inputs (loop (match inputs
(((labels things _ ...) ...) (((labels things _ ...) ...)
(append things tail))) (append things tail)))