M build-aux/hydra/gnu-system.scm => build-aux/hydra/gnu-system.scm +1 -2
@@ 204,8 204,7 @@ all its dependencies, and ready to be installed on non-GuixSD distributions.")
valid."
(cond ((member package base-packages)
#f)
- ((member system
- (package-transitive-supported-systems package))
+ ((supported-package? package system)
(package-job store (job-name package) package system))
(else
#f)))))
M guix/packages.scm => guix/packages.scm +6 -0
@@ 95,6 95,7 @@
package-grafts
%supported-systems
+ supported-package?
&package-error
package-error?
@@ 581,6 582,11 @@ supported by its dependencies."
(package-supported-systems 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)
"Same as 'package-direct-inputs', but applied to a bag."
(append (bag-build-inputs bag)
M tests/packages.scm => tests/packages.scm +8 -0
@@ 166,6 166,14 @@
`("does-not-exist" "foobar" ,@%supported-systems)))))
(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-assert "package-source-derivation, file"