02/03: hydra: Completely disable grafting.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 49c4fd2aab0c99c32ec338949ff07bd89d2920f6
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 2 23:42:57 2016 +0100

    hydra: Completely disable grafting.
    
    * build-aux/hydra/gnu-system.scm (hydra-jobs): Parameterize '%graft?'.
    Build package replacements when they are available.
---
 build-aux/hydra/gnu-system.scm |   56 +++++++++++++++++++++++----------------
 1 files changed, 33 insertions(+), 23 deletions(-)

diff --git a/build-aux/hydra/gnu-system.scm b/build-aux/hydra/gnu-system.scm
index fb22396..c5004a6 100644
--- a/build-aux/hydra/gnu-system.scm
+++ b/build-aux/hydra/gnu-system.scm
@@ -38,6 +38,7 @@
 
 (use-modules (guix config)
              (guix store)
+             (guix grafts)
              (guix packages)
              (guix derivations)
              (guix monads)
@@ -248,26 +249,35 @@ valid."
                        %packages-to-cross-build))
                 (remove (either from-32-to-64? same?) %cross-targets)))
 
-  ;; Return one job for each package, except bootstrap packages.
-  (append-map (lambda (system)
-                (case subset
-                  ((all)
-                   ;; Build everything.
-                   (let ((all (fold-packages cons '()))
-                         (job (lambda (package)
-                                (package->job store package
-                                              system))))
-                     (append (filter-map job all)
-                             (qemu-jobs store system)
-                             (tarball-jobs store system)
-                             (cross-jobs system))))
-                  ((core)
-                   ;; Build core packages only.
-                   (append (map (lambda (package)
-                                  (package-job store (job-name package)
-                                               package system))
-                                %core-packages)
-                           (cross-jobs system)))
-                  (else
-                   (error "unknown subset" subset))))
-              %hydra-supported-systems))
+  ;; Turn off grafts.  Grafting is meant to happen on the user's machines.
+  (parameterize ((%graft? #f))
+    ;; Return one job for each package, except bootstrap packages.
+    (append-map (lambda (system)
+                  (case subset
+                    ((all)
+                     ;; Build everything, including replacements.
+                     (let ((all (fold-packages
+                                 (lambda (package result)
+                                   (if (package-replacement package)
+                                       (cons* package
+                                              (package-replacement package)
+                                              result)
+                                       (cons package result)))
+                                 '()))
+                           (job (lambda (package)
+                                  (package->job store package
+                                                system))))
+                       (append (filter-map job all)
+                               (qemu-jobs store system)
+                               (tarball-jobs store system)
+                               (cross-jobs system))))
+                    ((core)
+                     ;; Build core packages only.
+                     (append (map (lambda (package)
+                                    (package-job store (job-name package)
+                                                 package system))
+                                  %core-packages)
+                             (cross-jobs system)))
+                    (else
+                     (error "unknown subset" subset))))
+                %hydra-supported-systems)))