nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: Add 'supported-package?'. 

* guix/packages.scm (supported-package?): New procedure.
* tests/packages.scm ("supported-package?"): New test.
* build-aux/hydra/gnu-system.scm (package->job): Use it instead of
  'package-transitive-supported-systems'.
This commit is contained in:
Ludovic Courtès 2015-04-19 16:49:09 +02:00
parent 42f118010b
commit bbceb0ef8a
3 changed files with 15 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -204,8 +204,7 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
valid." valid."
(cond ((member package base-packages) (cond ((member package base-packages)
#f) #f)
((member system ((supported-package? package 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)))))

6
guix/packages.scm
View File

@ -95,6 +95,7 @@
package-grafts package-grafts
%supported-systems %supported-systems
supported-package?
&package-error &package-error
package-error? package-error?
@ -581,6 +582,11 @@ supported by its dependencies."
(package-supported-systems package) (package-supported-systems package)
(bag-direct-inputs (package->bag package)))) (bag-direct-inputs (package->bag package))))
(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)))
(define (bag-direct-inputs bag) (define (bag-direct-inputs bag)
"Same as 'package-direct-inputs', but applied to a bag." "Same as 'package-direct-inputs', but applied to a bag."
(append (bag-build-inputs bag) (append (bag-build-inputs bag)

8
tests/packages.scm
View File

@ -166,6 +166,14 @@
`("does-not-exist" "foobar" ,@%supported-systems))))) `("does-not-exist" "foobar" ,@%supported-systems)))))
(package-transitive-supported-systems p))) (package-transitive-supported-systems p)))
(test-assert "supported-package?"
(let ((p (dummy-package "foo"
(build-system gnu-build-system)
(supported-systems '("x86_64-linux" "does-not-exist")))))
(and (supported-package? p "x86_64-linux")
(not (supported-package? p "does-not-exist"))
(not (supported-package? p "i686-linux")))))
(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"