check-available-binaries: Use 'substitutable-paths'.

e348eaaf · Ludovic Courtès <[email protected]> · 2015-07-21 22:28:20 +02:00

* 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.

Commit: e348eaaf318646e259a5e6803133ad5b296febc1
Parents: e9ade3ee

Changes

1 files changed · +12 −15

File	Status	Add	Del	Content
build-aux/check-available-binaries.scm	modified	+12	−15	View file

build-aux/check-available-binaries.scm

View file

diff --git a/build-aux/check-available-binaries.scm b/build-aux/check-available-binaries.scm
index 04f88b7..771dcd9 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))))))