store: Test the `fallback?' store option.

* guix/store.scm (set-build-options): Rename #:try-fallback? to #:fallback?.
* tests/store.scm ("substitute --fallback"): New test.
This commit is contained in:
Ludovic Courtès 2013-05-29 23:04:15 +02:00
parent acc26ff148
commit c3eb878f0b
2 changed files with 53 additions and 2 deletions

View file

@ -354,7 +354,7 @@ (define %stderr-error #x63787470)
(status k)))))))) (status k))))))))
(define* (set-build-options server (define* (set-build-options server
#:key keep-failed? keep-going? try-fallback? #:key keep-failed? keep-going? fallback?
(verbosity 0) (verbosity 0)
(max-build-jobs (current-processor-count)) (max-build-jobs (current-processor-count))
(max-silent-time 3600) (max-silent-time 3600)
@ -377,7 +377,7 @@ (define socket
...))))) ...)))))
(write-int (operation-id set-options) socket) (write-int (operation-id set-options) socket)
(send (boolean keep-failed?) (boolean keep-going?) (send (boolean keep-failed?) (boolean keep-going?)
(boolean try-fallback?) (integer verbosity) (boolean fallback?) (integer verbosity)
(integer max-build-jobs) (integer max-silent-time)) (integer max-build-jobs) (integer max-silent-time))
(if (>= (nix-server-minor-version server) 2) (if (>= (nix-server-minor-version server) 2)
(send (boolean use-build-hook?))) (send (boolean use-build-hook?)))

View file

@ -31,6 +31,7 @@ (define-module (test-store)
#:use-module (web uri) #:use-module (web uri)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
;; Test the (guix store) module. ;; Test the (guix store) module.
@ -226,6 +227,56 @@ (define (random-text)
(build-derivations s (list d)) (build-derivations s (list d))
(equal? c (call-with-input-file o get-string-all))))) (equal? c (call-with-input-file o get-string-all)))))
(test-assert "substitute --fallback"
(let* ((s (open-connection))
(t (random-text)) ; contents of the output
(d (build-expression->derivation
s "substitute-me-not" (%current-system)
`(call-with-output-file %output
(lambda (p)
(display ,t p)))
'()
#:guile-for-build
(package-derivation s %bootstrap-guile (%current-system))))
(o (derivation-path->output-path d))
(dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
(compose uri-path string->uri))))
;; Create fake substituter data, to be read by `substitute-binary'.
(call-with-output-file (string-append dir "/nix-cache-info")
(lambda (p)
(format p "StoreDir: ~a\nWantMassQuery: 0\n"
(%store-prefix))))
(call-with-output-file (string-append dir "/" (store-path-hash-part o)
".narinfo")
(lambda (p)
(format p "StorePath: ~a
URL: ~a
Compression: none
NarSize: 1234
NarHash: sha256:0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
References:
System: ~a
Deriver: ~a~%"
o ; StorePath
"does-not-exist.nar" ; relative URL
(%current-system) ; System
(basename d)))) ; Deriver
;; Make sure we use `substitute-binary'.
(set-build-options s #:use-substitutes? #t)
(and (has-substitutes? s o)
(guard (c ((nix-protocol-error? c)
;; The substituter failed as expected. Now make sure that
;; #:fallback? #t works correctly.
(set-build-options s
#:use-substitutes? #t
#:fallback? #t)
(and (build-derivations s (list d))
(equal? t (call-with-input-file o get-string-all)))))
;; Should fail.
(build-derivations s (list d))
#f))))
(test-end "store") (test-end "store")