02/04: store: Allow clients to request multiple builds.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 2fba87ac7c3e6fc6ca1a6e94131303c37425b2ba
Author: Ludovic Courtès <address@hidden>
Date:   Tue Dec 8 22:58:32 2015 +0100

    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.
---
 guix/store.scm  |    5 +++++
 tests/store.scm |   40 ++++++++++++++++++++++++++++++++++++++++
 2 files changed, 45 insertions(+), 0 deletions(-)

diff --git a/guix/store.scm b/guix/store.scm
index 98ccbd1..3c4d1c0 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 72abf2c..394c06b 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))