nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

48
build-aux/check-available-binaries.scm
View File

@ -28,28 +28,28 @@
(srfi srfi-1) (srfi srfi-1)
(srfi srfi-26)) (srfi srfi-26))
(let* ((store (open-connection)) (with-store store
(native (append-map (lambda (system) (let* ((native (append-map (lambda (system)
(map (cut package-derivation store <> system) (map (cut package-derivation store <> system)
(list %bootstrap-tarballs emacs))) (list %bootstrap-tarballs emacs)))
%supported-systems)) %supported-systems))
(cross (map (cut package-cross-derivation store (cross (map (cut package-cross-derivation store
%bootstrap-tarballs <>) %bootstrap-tarballs <>)
'("mips64el-linux-gnuabi64"))) '("mips64el-linux-gnuabi64")))
(total (append native cross))) (total (append native cross)))
(define (warn proc) (define (warn proc)
(lambda (drv) (lambda (drv)
(or (proc drv) (or (proc drv)
(begin (begin
(format (current-error-port) "~a is not substitutable~%" (format (current-error-port) "~a is not substitutable~%"
drv) drv)
#f)))) #f))))
(set-build-options store #:use-substitutes? #t) (set-build-options store #:use-substitutes? #t)
(let ((result (every (compose (warn (cut has-substitutes? store <>)) (let ((result (every (compose (warn (cut has-substitutes? store <>))
derivation->output-path) derivation->output-path)
total))) total)))
(when result (when result
(format (current-error-port) "~a packages found substitutable~%" (format (current-error-port) "~a packages found substitutable~%"
(length total))) (length total)))
(exit result))) (exit result))))