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

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit e348eaaf318646e259a5e6803133ad5b296febc1
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jul 21 22:28:20 2015 +0200

    check-available-binaries: Use 'substitutable-paths'.
    
    * 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.
---
 build-aux/check-available-binaries.scm |   27 ++++++++++++---------------
 1 files changed, 12 insertions(+), 15 deletions(-)

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))))))