summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-07-21 22:28:20 +0200
committerLudovic Courtès <ludo@gnu.org>2015-07-21 22:28:20 +0200
commite348eaaf318646e259a5e6803133ad5b296febc1 (patch)
tree627924a9b94ca5ae13a350c4aa2e8a1ec069a107
parente9ade3eeef5e79a48e83be7847cb39eee497f862 (diff)
downloadguix-e348eaaf318646e259a5e6803133ad5b296febc1.tar.gz
check-available-binaries: Use 'substitutable-paths'. v0.8.3
* build-aux/check-available-binaries.scm: Rewrite to use 'substitutable-paths'
  instead of 'substitution-oracle'.  The latter does more than we need, and it
  no longer check the substitutability of valid items, which is not what we
  want.  Use 'lset-difference' instead of iterating over the items.
-rw-r--r--build-aux/check-available-binaries.scm27
1 files changed, 12 insertions, 15 deletions
diff --git a/build-aux/check-available-binaries.scm b/build-aux/check-available-binaries.scm
index 04f88b7d0c..771dcd96b3 100644
--- a/build-aux/check-available-binaries.scm
+++ b/build-aux/check-available-binaries.scm
@@ -26,7 +26,8 @@
              (gnu packages emacs)
              (gnu packages make-bootstrap)
              (srfi srfi-1)
-             (srfi srfi-26))
+             (srfi srfi-26)
+             (ice-9 format))
 
 (with-store store
   (parameterize ((%graft? #f))
@@ -38,19 +39,15 @@
                              %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)))))
+      (let* ((total     (map derivation->output-path total))
+             (available (substitutable-paths store total))
+             (missing   (lset-difference string=? total available)))
+        (if (null? missing)
+            (format (current-error-port) "~a packages found substitutable~%"
+                    (length total))
+            (format (current-error-port)
+                    "~a packages are not substitutable:~%~{  ~a~%~}~%"
+                    (length missing) missing))
+        (exit (null? missing))))))