mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 13:28:12 -05:00
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:
parent
acc26ff148
commit
c3eb878f0b
2 changed files with 53 additions and 2 deletions
|
@ -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?)))
|
||||||
|
|
|
@ -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")
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue