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.master
parent
67a86d3b8d
commit
7c3c0374de
|
@ -172,7 +172,8 @@ system.")
|
||||||
valid."
|
valid."
|
||||||
(cond ((member package base-packages)
|
(cond ((member package base-packages)
|
||||||
#f)
|
#f)
|
||||||
((member system (package-supported-systems package))
|
((member system
|
||||||
|
(package-transitive-supported-systems package))
|
||||||
(package-job store (job-name package) package system))
|
(package-job store (job-name package) package system))
|
||||||
(else
|
(else
|
||||||
#f)))))
|
#f)))))
|
||||||
|
|
|
@ -80,6 +80,7 @@
|
||||||
package-transitive-target-inputs
|
package-transitive-target-inputs
|
||||||
package-transitive-native-inputs
|
package-transitive-native-inputs
|
||||||
package-transitive-propagated-inputs
|
package-transitive-propagated-inputs
|
||||||
|
package-transitive-supported-systems
|
||||||
package-source-derivation
|
package-source-derivation
|
||||||
package-derivation
|
package-derivation
|
||||||
package-cross-derivation
|
package-cross-derivation
|
||||||
|
@ -537,6 +538,17 @@ for the host system (\"native inputs\"), and not target inputs."
|
||||||
recursively."
|
recursively."
|
||||||
(transitive-inputs (package-propagated-inputs package)))
|
(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)
|
(define (bag-transitive-inputs bag)
|
||||||
"Same as 'package-transitive-inputs', but applied to a bag."
|
"Same as 'package-transitive-inputs', but applied to a bag."
|
||||||
(transitive-inputs (append (bag-build-inputs bag)
|
(transitive-inputs (append (bag-build-inputs bag)
|
||||||
|
|
|
@ -124,6 +124,19 @@
|
||||||
("d" ,d) ("d/x" "something.drv"))
|
("d" ,d) ("d/x" "something.drv"))
|
||||||
(pk 'x (package-transitive-inputs e))))))
|
(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-skip (if (not %store) 8 0))
|
||||||
|
|
||||||
(test-assert "package-source-derivation, file"
|
(test-assert "package-source-derivation, file"
|
||||||
|
|
Reference in New Issue