check-available-binaries: Use 'with-store'.

* build-aux/check-available-binaries.scm: Use 'with-store' instead of an
  explicit 'open-connection'.
This commit is contained in:
Ludovic Courtès 2015-01-14 18:20:01 +01:00
parent 58caebf032
commit 619c9522b2
1 changed files with 24 additions and 24 deletions

View File

@ -28,28 +28,28 @@
(srfi srfi-1)
(srfi srfi-26))
(let* ((store (open-connection))
(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 proc)
(lambda (drv)
(or (proc drv)
(begin
(format (current-error-port) "~a is not substitutable~%"
drv)
#f))))
(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 proc)
(lambda (drv)
(or (proc drv)
(begin
(format (current-error-port) "~a is not substitutable~%"
drv)
#f))))
(set-build-options store #:use-substitutes? #t)
(let ((result (every (compose (warn (cut has-substitutes? store <>))
derivation->output-path)
total)))
(when result
(format (current-error-port) "~a packages found substitutable~%"
(length total)))
(exit result)))
(set-build-options store #:use-substitutes? #t)
(let ((result (every (compose (warn (cut has-substitutes? store <>))
derivation->output-path)
total)))
(when result
(format (current-error-port) "~a packages found substitutable~%"
(length total)))
(exit result))))