TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

store: Allow clients to request multiple builds. 

* guix/store.scm (set-build-options): Add #:rounds parameter and honor it.
* tests/store.scm ("build multiple times"): New test.
This commit is contained in:
Ludovic Courtès 2015-12-08 22:58:32 +01:00
parent b23b4d394a
commit 2fba87ac7c
2 changed files with 45 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
guix/store.scm
View File

@ -504,6 +504,7 @@ encoding conversion errors."
(define* (set-build-options server
#:key keep-failed? keep-going? fallback?
(verbosity 0)
rounds ;number of build rounds
(max-build-jobs 1)
timeout
(max-silent-time 3600)
@ -549,6 +550,10 @@ encoding conversion errors."
,@(if substitute-urls
`(("substitute-urls"
. ,(string-join substitute-urls)))
'())
,@(if rounds
`(("build-repeat"
. ,(number->string (max 0 (1- rounds)))))
'()))))
(send (string-pairs pairs))))
(let loop ((done? (process-stderr server)))

40
tests/store.scm
View File

@ -769,6 +769,8 @@
(let ((out (assoc-ref %outputs "out")))
(call-with-output-file out
(lambda (port)
;; Rely on the fact that tests do not use the
;; chroot, and thus ENTROPY is readable.
(display (call-with-input-file ,entropy
get-string-all)
port)))
@ -791,6 +793,44 @@
(build-mode check))
#f))))))))
(test-assert "build multiple times"
(with-store store
;; Ask to build twice.
(set-build-options store #:rounds 2 #:use-substitutes? #f)
(call-with-temporary-output-file
(lambda (entropy entropy-port)
(write (random-text) entropy-port)
(force-output entropy-port)
(let* ((drv (build-expression->derivation
store "non-deterministic"
`(begin
(use-modules (rnrs io ports))
(let ((out (assoc-ref %outputs "out")))
(call-with-output-file out
(lambda (port)
;; Rely on the fact that tests do not use the
;; chroot, and thus ENTROPY is accessible.
(display (call-with-input-file ,entropy
get-string-all)
port)
(call-with-output-file ,entropy
(lambda (port)
(write 'foobar port)))))
#t))
#:guile-for-build
(package-derivation store %bootstrap-guile (%current-system))))
(file (derivation->output-path drv)))
(guard (c ((nix-protocol-error? c)
(pk 'multiple-build c)
(and (not (zero? (nix-protocol-error-status c)))
(string-contains (nix-protocol-error-message c)
"deterministic"))))
;; This one will produce a different result on the second run.
(current-build-output-port (current-error-port))
(build-things store (list (derivation-file-name drv)))
#f))))))
(test-equal "store-lower"
"Lowered."
(let* ((add (store-lower text-file))