me
/
guix
Archived
1
0
Fork 0
Code

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
Ludovic Courtès 2014-10-17 23:20:39 +02:00
parent 67a86d3b8d
commit 7c3c0374de
3 changed files with 27 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
build-aux/hydra/gnu-system.scm
View File

@ -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)))))

12
guix/packages.scm
View File

@ -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)

13
tests/packages.scm
View File

@ -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"