01/05: build: Disable grafting in sanity checks.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 43da8f018d5835b62e8f5f1f4e2cc701f828a3db
Author: Ludovic Courtès <address@hidden>
Date:   Tue Feb 24 23:00:29 2015 +0100

    build: Disable grafting in sanity checks.
    
    * build-aux/check-available-binaries.scm: Wrap body in 'parameterize'
      form that clears '%graft?'.
    * build-aux/check-final-inputs-self-contained.scm: Likewise.
---
 build-aux/check-available-binaries.scm          |   47 ++++++++++++-----------
 build-aux/check-final-inputs-self-contained.scm |    7 ++-
 2 files changed, 28 insertions(+), 26 deletions(-)

diff --git a/build-aux/check-available-binaries.scm 
b/build-aux/check-available-binaries.scm
index 7ac4352..bc6207e 100644
--- a/build-aux/check-available-binaries.scm
+++ b/build-aux/check-available-binaries.scm
@@ -29,27 +29,28 @@
              (srfi srfi-26))
 
 (with-store store
-  (let* ((native (append-map (lambda (system)
-                               (map (cut package-derivation store <> system)
-                                    (list %bootstrap-tarballs emacs)))
-                             %supported-systems))
-         (cross  (map (cut package-cross-derivation store
-                           %bootstrap-tarballs <>)
-                      '("mips64el-linux-gnuabi64")))
-         (total  (append native cross)))
-    (define (warn item system)
-      (format (current-error-port) "~a (~a) is not substitutable~%"
-              item system)
-      #f)
+  (parameterize ((%graft? #f))
+    (let* ((native (append-map (lambda (system)
+                                 (map (cut package-derivation store <> system)
+                                      (list %bootstrap-tarballs emacs)))
+                               %supported-systems))
+           (cross  (map (cut package-cross-derivation store
+                             %bootstrap-tarballs <>)
+                        '("mips64el-linux-gnuabi64")))
+           (total  (append native cross)))
+      (define (warn item system)
+        (format (current-error-port) "~a (~a) is not substitutable~%"
+                item system)
+        #f)
 
-    (set-build-options store #:use-substitutes? #t)
-    (let* ((substitutable? (substitution-oracle store total))
-           (result         (every (lambda (drv)
-                                    (let ((out (derivation->output-path drv)))
-                                      (or (substitutable? out)
-                                          (warn out (derivation-system drv)))))
-                                  total)))
-      (when result
-        (format (current-error-port) "~a packages found substitutable~%"
-                (length total)))
-      (exit result))))
+      (set-build-options store #:use-substitutes? #t)
+      (let* ((substitutable? (substitution-oracle store total))
+             (result         (every (lambda (drv)
+                                      (let ((out (derivation->output-path 
drv)))
+                                        (or (substitutable? out)
+                                            (warn out (derivation-system 
drv)))))
+                                    total)))
+        (when result
+          (format (current-error-port) "~a packages found substitutable~%"
+                  (length total)))
+        (exit result)))))
diff --git a/build-aux/check-final-inputs-self-contained.scm 
b/build-aux/check-final-inputs-self-contained.scm
index ca7e803..ba85c87 100644
--- a/build-aux/check-final-inputs-self-contained.scm
+++ b/build-aux/check-final-inputs-self-contained.scm
@@ -73,8 +73,9 @@ refer to the bootstrap tools."
 
 ;; Entry point.
 (with-store store
-  (set-build-options store #:use-substitutes? #t)
+  (parameterize ((%graft? #f))
+    (set-build-options store #:use-substitutes? #t)
 
-  (for-each (cut test-final-inputs store <>)
-            %supported-systems))
+    (for-each (cut test-final-inputs store <>)
+              %supported-systems)))