~ruther/guix-local

c3eb878f0beb792f19d72edef62f267560c39162 — Ludovic Courtès 12 years ago acc26ff
store: Test the `fallback?' store option.

* guix/store.scm (set-build-options): Rename #:try-fallback? to #:fallback?.
* tests/store.scm ("substitute --fallback"): New test.
2 files changed, 53 insertions(+), 2 deletions(-)

M guix/store.scm
M tests/store.scm
M guix/store.scm => guix/store.scm +2 -2
@@ 354,7 354,7 @@ encoding conversion errors."
                              (status   k))))))))

(define* (set-build-options server
                            #:key keep-failed? keep-going? try-fallback?
                            #:key keep-failed? keep-going? fallback?
                            (verbosity 0)
                            (max-build-jobs (current-processor-count))
                            (max-silent-time 3600)


@@ 377,7 377,7 @@ encoding conversion errors."
                          ...)))))
    (write-int (operation-id set-options) socket)
    (send (boolean keep-failed?) (boolean keep-going?)
          (boolean try-fallback?) (integer verbosity)
          (boolean fallback?) (integer verbosity)
          (integer max-build-jobs) (integer max-silent-time))
    (if (>= (nix-server-minor-version server) 2)
        (send (boolean use-build-hook?)))

M tests/store.scm => tests/store.scm +51 -0
@@ 31,6 31,7 @@
  #:use-module (web uri)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-11)
  #:use-module (srfi srfi-34)
  #:use-module (srfi srfi-64))

;; Test the (guix store) module.


@@ 226,6 227,56 @@ Deriver: ~a~%"
         (build-derivations s (list d))
         (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")