build: Disable grafting in sanity checks.

* build-aux/check-available-binaries.scm: Wrap body in 'parameterize'
  form that clears '%graft?'.
* build-aux/check-final-inputs-self-contained.scm: Likewise.
This commit is contained in:
Ludovic Courtès 2015-02-24 23:00:29 +01:00
parent 9ffee4571c
commit 43da8f018d
2 changed files with 28 additions and 26 deletions

View file

@ -29,27 +29,28 @@
(srfi srfi-26)) (srfi srfi-26))
(with-store store (with-store store
(let* ((native (append-map (lambda (system) (parameterize ((%graft? #f))
(map (cut package-derivation store <> system) (let* ((native (append-map (lambda (system)
(list %bootstrap-tarballs emacs))) (map (cut package-derivation store <> system)
%supported-systems)) (list %bootstrap-tarballs emacs)))
(cross (map (cut package-cross-derivation store %supported-systems))
%bootstrap-tarballs <>) (cross (map (cut package-cross-derivation store
'("mips64el-linux-gnuabi64"))) %bootstrap-tarballs <>)
(total (append native cross))) '("mips64el-linux-gnuabi64")))
(define (warn item system) (total (append native cross)))
(format (current-error-port) "~a (~a) is not substitutable~%" (define (warn item system)
item system) (format (current-error-port) "~a (~a) is not substitutable~%"
#f) item system)
#f)
(set-build-options store #:use-substitutes? #t) (set-build-options store #:use-substitutes? #t)
(let* ((substitutable? (substitution-oracle store total)) (let* ((substitutable? (substitution-oracle store total))
(result (every (lambda (drv) (result (every (lambda (drv)
(let ((out (derivation->output-path drv))) (let ((out (derivation->output-path drv)))
(or (substitutable? out) (or (substitutable? out)
(warn out (derivation-system drv))))) (warn out (derivation-system drv)))))
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)))))

View file

@ -73,8 +73,9 @@ (define (test-final-inputs store system)
;; Entry point. ;; Entry point.
(with-store store (with-store store
(set-build-options store #:use-substitutes? #t) (parameterize ((%graft? #f))
(set-build-options store #:use-substitutes? #t)
(for-each (cut test-final-inputs store <>) (for-each (cut test-final-inputs store <>)
%supported-systems)) %supported-systems)))