diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm index 01e2859f1a..b1432f6660 100644 --- a/build-aux/hydra/gnu-system.scm +++ b/build-aux/hydra/gnu-system.scm @@ -204,8 +204,7 @@ (define package->job 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))))) diff --git a/guix/packages.scm b/guix/packages.scm index 8ebe8d06b5..fde46d5d6a 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -95,6 +95,7 @@ (define-module (guix packages) package-grafts %supported-systems + supported-package? &package-error package-error? @@ -581,6 +582,11 @@ (define-memoized/v (package-transitive-supported-systems package) (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) diff --git a/tests/packages.scm b/tests/packages.scm index 3007b50b92..91910324fe 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -166,6 +166,14 @@ (define read-at `("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"