From bbceb0ef8a1e05faaa15c5b4135275fb4572b8d9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sun, 19 Apr 2015 16:49:09 +0200
Subject: 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'.
---
 build-aux/hydra/gnu-system.scm | 3 +--
 guix/packages.scm              | 6 ++++++
 tests/packages.scm             | 8 ++++++++
 3 files changed, 15 insertions(+), 2 deletions(-)

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"
-- 
cgit v1.2.3