~ruther/guix-local

2fba87ac7c3e6fc6ca1a6e94131303c37425b2ba — Ludovic Courtès 10 years ago b23b4d3
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.
2 files changed, 45 insertions(+), 0 deletions(-)

M guix/store.scm
M tests/store.scm
M guix/store.scm => guix/store.scm +5 -0
@@ 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)))

M tests/store.scm => tests/store.scm +40 -0
@@ 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))