From 7c3c0374de446af387c8478f77083fd0e357253c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 17 Oct 2014 23:20:39 +0200
Subject: [PATCH] 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.
---
 build-aux/hydra/gnu-system.scm |  3 ++-
 guix/packages.scm              | 12 ++++++++++++
 tests/packages.scm             | 13 +++++++++++++
 3 files changed, 27 insertions(+), 1 deletion(-)

diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index c26bcff6ae..c7ad730abc 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -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)))))
diff --git a/guix/packages.scm b/guix/packages.scm
index 070eb4e9d5..97a82a4682 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -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)
diff --git a/tests/packages.scm b/tests/packages.scm
index 88d21e0578..ceb2299748 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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"