From c3eb878f0beb792f19d72edef62f267560c39162 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Wed, 29 May 2013 23:04:15 +0200
Subject: store: Test the `fallback?' store option.

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

diff --git a/guix/store.scm b/guix/store.scm
index b82588b2a0..d15ba1275f 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -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?)))
diff --git a/tests/store.scm b/tests/store.scm
index 677e39e75d..c0126ce335 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -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")
 
 
-- 
cgit 1.4.1