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.
master
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
1 changed files with 12 additions and 8 deletions

View File

@ -996,14 +996,18 @@ and return it."
"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
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
(match (if native?
(append (bag-build-inputs bag)
(bag-target-inputs bag)
(if (bag-target bag)
'()
(bag-host-inputs bag)))
(bag-host-inputs bag))
(match (bag-direct-inputs* bag)
(((labels things _ ...) ...)
things)))
@ -1016,7 +1020,7 @@ dependencies; otherwise, restrict to target dependencies."
(((? package? head) . tail)
(if (set-contains? visited head)
(loop tail result visited)
(let ((inputs (bag-direct-inputs (package->bag head))))
(let ((inputs (bag-direct-inputs* (package->bag head))))
(loop (match inputs
(((labels things _ ...) ...)
(append things tail)))