diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-09-06 14:41:58 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-09-06 14:41:58 +0200 |
commit | bc60349b5bc58a0b803df5adce1de6db82453744 (patch) | |
tree | d11777318a93c1f85b579f9e86c7bd402e52b368 /guix/packages.scm | |
parent | d2d63e20d5b981009b61bf416b4d7b516e8f1f34 (diff) | |
download | patches-bc60349b5bc58a0b803df5adce1de6db82453744.tar patches-bc60349b5bc58a0b803df5adce1de6db82453744.tar.gz |
packages: 'supported-package?' binds '%current-system' for graph traversal.
Previously, (supported-package? coreutils "armhf-linux")
with (%current-system) = "x86_64-linux" would return false. That's
because 'supported-package?' would traverse the x86_64 dependency graph,
which contains 'tcc-boot0', which supports x86 only.
Consequently, 'supported-package?' would match only 53 packages for
"armhf-linux" when running on x86, as is the case during continuous
integration.
* guix/packages.scm (package-transitive-supported-systems): Add an
optional 'system' parameter. Use 'mlambda' instead of 'mlambdaq' for
memoization.
(supported-package?): Pass 'system' to 'package-transitive-supported-systems'.
* tests/packages.scm ("package-transitive-supported-systems, implicit inputs")
("package-transitive-supported-systems: reduced binary seed, implicit inputs"):
Remove calls to 'invalidate-memoization!', which no longer work and were
presumably introduced to work around the bug we're fixing (see commit
0db65c168fd6dec57a357735fe130c80feba5460).
* tests/packages.scm ("supported-package?"): Rewrite test to use only
existing system name since otherwise 'bootstrap-executable' raises an
exception.
("supported-package? vs. system-dependent graph"): New test.
Diffstat (limited to 'guix/packages.scm')
-rw-r--r-- | guix/packages.scm | 30 |
1 files changed, 18 insertions, 12 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index d9eeee15a2..39ab28d807 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -767,23 +767,29 @@ in INPUTS and their transitive propagated inputs." (transitive-inputs inputs))) (define package-transitive-supported-systems - (mlambdaq (package) - "Return the intersection of the systems supported by PACKAGE and those + (let () + (define supported-systems + (mlambda (package system) + (parameterize ((%current-system system)) + (fold (lambda (input systems) + (match input + ((label (? package? package) . _) + (lset-intersection string=? systems + (supported-systems package system))) + (_ + systems))) + (package-supported-systems package) + (bag-direct-inputs (package->bag package)))))) + + (lambda* (package #:optional (system (%current-system))) + "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (fold (lambda (input systems) - (match input - ((label (? package? p) . _) - (lset-intersection - string=? systems (package-transitive-supported-systems p))) - (_ - systems))) - (package-supported-systems package) - (bag-direct-inputs (package->bag package))))) + (supported-systems package system)))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its dependencies are known to build on SYSTEM." - (member system (package-transitive-supported-systems package))) + (member system (package-transitive-supported-systems package system))) (define (bag-direct-inputs bag) "Same as 'package-direct-inputs', but applied to a bag." |