diff options
| -rw-r--r-- | guix/store.scm | 5 | ||||
| -rw-r--r-- | tests/store.scm | 40 |
2 files changed, 45 insertions, 0 deletions
diff --git a/guix/store.scm b/guix/store.scm index 98ccbd1004..3c4d1c0058 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -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))) diff --git a/tests/store.scm b/tests/store.scm index 72abf2c694..394c06bc0f 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -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)) |