diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-07-21 22:28:20 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-07-21 22:28:20 +0200 |
| commit | e348eaaf318646e259a5e6803133ad5b296febc1 (patch) | |
| tree | 627924a9b94ca5ae13a350c4aa2e8a1ec069a107 | |
| parent | e9ade3eeef5e79a48e83be7847cb39eee497f862 (diff) | |
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.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 04f88b7d0c4..771dcd96b35 100644 --- a/build-aux/check-available-binaries.scm +++ b/build-aux/check-available-binaries.scm | |||
| @@ -26,7 +26,8 @@ | |||
| 26 | (gnu packages emacs) | 26 | (gnu packages emacs) |
| 27 | (gnu packages make-bootstrap) | 27 | (gnu packages make-bootstrap) |
| 28 | (srfi srfi-1) | 28 | (srfi srfi-1) |
| 29 | (srfi srfi-26)) | 29 | (srfi srfi-26) |
| 30 | (ice-9 format)) | ||
| 30 | 31 | ||
| 31 | (with-store store | 32 | (with-store store |
| 32 | (parameterize ((%graft? #f)) | 33 | (parameterize ((%graft? #f)) |
| @@ -38,19 +39,15 @@ | |||
| 38 | %bootstrap-tarballs <>) | 39 | %bootstrap-tarballs <>) |
| 39 | '("mips64el-linux-gnuabi64"))) | 40 | '("mips64el-linux-gnuabi64"))) |
| 40 | (total (append native cross))) | 41 | (total (append native cross))) |
| 41 | (define (warn item system) | ||
| 42 | (format (current-error-port) "~a (~a) is not substitutable~%" | ||
| 43 | item system) | ||
| 44 | #f) | ||
| 45 | 42 | ||
| 46 | (set-build-options store #:use-substitutes? #t) | 43 | (set-build-options store #:use-substitutes? #t) |
| 47 | (let* ((substitutable? (substitution-oracle store total)) | 44 | (let* ((total (map derivation->output-path total)) |
| 48 | (result (every (lambda (drv) | 45 | (available (substitutable-paths store total)) |
| 49 | (let ((out (derivation->output-path drv))) | 46 | (missing (lset-difference string=? total available))) |
| 50 | (or (substitutable? out) | 47 | (if (null? missing) |
| 51 | (warn out (derivation-system drv))))) | 48 | (format (current-error-port) "~a packages found substitutable~%" |
| 52 | total))) | 49 | (length total)) |
| 53 | (when result | 50 | (format (current-error-port) |
| 54 | (format (current-error-port) "~a packages found substitutable~%" | 51 | "~a packages are not substitutable:~%~{ ~a~%~}~%" |
| 55 | (length total))) | 52 | (length missing) missing)) |
| 56 | (exit result))))) | 53 | (exit (null? missing)))))) |
