diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-10-17 23:20:39 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-10-17 23:23:21 +0200 |
| commit | 7c3c0374de446af387c8478f77083fd0e357253c (patch) | |
| tree | 96901f0b59c5bd7127ec010f541959dd5d47c28f | |
| parent | 67a86d3b8d17b921728eec7776677582cfdd9266 (diff) | |
| download | guix-7c3c0374de446af387c8478f77083fd0e357253c.tar.gz | |
packages: Add 'package-transitive-supported-systems'.
* guix/packages.scm (package-transitive-supported-systems): New procedure.
* tests/packages.scm ("package-transitive-supported-systems"): New test.
* build-aux/hydra/gnu-system.scm (package->job): Use it.
| -rw-r--r-- | build-aux/hydra/gnu-system.scm | 3 | ||||
| -rw-r--r-- | guix/packages.scm | 12 | ||||
| -rw-r--r-- | tests/packages.scm | 13 |
3 files changed, 27 insertions, 1 deletions
diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index c26bcff6ae..c7ad730abc 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -172,7 +172,8 @@ system.") valid." (cond ((member package base-packages) #f) - ((member system (package-supported-systems package)) + ((member system + (package-transitive-supported-systems package)) (package-job store (job-name package) package system)) (else #f))))) diff --git a/guix/packages.scm b/guix/packages.scm index 070eb4e9d5..97a82a4682 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -80,6 +80,7 @@ package-transitive-target-inputs package-transitive-native-inputs package-transitive-propagated-inputs + package-transitive-supported-systems package-source-derivation package-derivation package-cross-derivation @@ -537,6 +538,17 @@ for the host system (\"native inputs\"), and not target inputs." recursively." (transitive-inputs (package-propagated-inputs package))) +(define (package-transitive-supported-systems package) + "Return the intersection of the systems supported by PACKAGE and those +supported by its dependencies." + (apply lset-intersection string=? + (package-supported-systems package) + (filter-map (match-lambda + ((label (? package? p) . rest) + (package-supported-systems p)) + (_ #f)) + (package-transitive-inputs package)))) + (define (bag-transitive-inputs bag) "Same as 'package-transitive-inputs', but applied to a bag." (transitive-inputs (append (bag-build-inputs bag) diff --git a/tests/packages.scm b/tests/packages.scm index 88d21e0578..ceb2299748 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -124,6 +124,19 @@ ("d" ,d) ("d/x" "something.drv")) (pk 'x (package-transitive-inputs e)))))) +(test-equal "package-transitive-supported-systems" + '(("x" "y" "z") + ("x" "y") + ("y")) + (let* ((a (dummy-package "a" (supported-systems '("x" "y" "z")))) + (b (dummy-package "b" (supported-systems '("x" "y")) + (inputs `(("a" ,a))))) + (c (dummy-package "c" (supported-systems '("y" "z")) + (inputs `(("b" ,b)))))) + (list (package-transitive-supported-systems a) + (package-transitive-supported-systems b) + (package-transitive-supported-systems c)))) + (test-skip (if (not %store) 8 0)) (test-assert "package-source-derivation, file" |