summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-12-03 19:08:35 +0200
committerLudovic Courtès <ludo@gnu.org>2015-12-03 19:09:53 +0200
commit07e70f4846521c1fa5319b25f23eea171a03fccd (patch)
tree6afe1552ef452c53e4f786953b9716e4d25bc5cd
parentd203d3d4cb3d83beaadaaef6c279c3d84ac142f7 (diff)
downloadguix-07e70f4846521c1fa5319b25f23eea171a03fccd.tar.gz
store: Add mode parameter to 'build-paths'.
* guix/store.scm (%protocol-version): Set minor to 15.
(build-mode): New enumerate type.
(build-things): Add 'mode' parameter; pass it to the RPC.
* tests/store.scm ("build-things, check mode"): New check.
-rw-r--r--guix/store.scm20
-rw-r--r--tests/store.scm35
2 files changed, 51 insertions, 4 deletions
diff --git a/guix/store.scm b/guix/store.scm
index 89f5df052a..1818187155 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -53,6 +53,7 @@
             nix-protocol-error-status
 
             hash-algo
+            build-mode
 
             open-connection
             close-connection
@@ -129,7 +130,7 @@
             direct-store-path
             log-file))
 
-(define %protocol-version #x10e)
+(define %protocol-version #x10f)
 
 (define %worker-magic-1 #x6e697863)               ; "nixc"
 (define %worker-magic-2 #x6478696f)               ; "dxio"
@@ -188,6 +189,12 @@
   (sha1 2)
   (sha256 3))
 
+(define-enumerate-type build-mode
+  ;; store-api.hh
+  (normal 0)
+  (repair 1)
+  (check 2))
+
 (define-enumerate-type gc-action
   ;; store-api.hh
   (return-live 0)
@@ -637,12 +644,17 @@ bits are kept.  HASH-ALGO must be a string such as \"sha256\"."
               (hash-set! cache args path)
               path))))))
 
-(define-operation (build-things (string-list things))
-  "Build THINGS, a list of store items which may be either '.drv' files or
+(define build-things
+  (let ((build (operation (build-things (string-list things)
+                                        (integer mode))
+                          "Do it!"
+                          boolean)))
+    (lambda* (store things #:optional (mode (build-mode normal)))
+      "Build THINGS, a list of store items which may be either '.drv' files or
 outputs, and return when the worker is done building them.  Elements of THINGS
 that are not derivations can only be substituted and not built locally.
 Return #t on success."
-  boolean)
+      (build store things mode))))
 
 (define-operation (add-temp-root (store-path path))
   "Make PATH a temporary root for the duration of the current session.
diff --git a/tests/store.scm b/tests/store.scm
index 60d1085f99..72abf2c694 100644
--- a/tests/store.scm
+++ b/tests/store.scm
@@ -756,6 +756,41 @@
              ;; Delete the corrupt item to leave the store in a clean state.
              (delete-paths s (list file)))))))
 
+(test-assert "build-things, check mode"
+  (with-store store
+    (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)
+                              (display (call-with-input-file ,entropy
+                                         get-string-all)
+                                       port)))
+                          #t))
+                     #:guile-for-build
+                     (package-derivation store %bootstrap-guile (%current-system))))
+              (file (derivation->output-path drv)))
+         (and (build-things store (list (derivation-file-name drv)))
+              (begin
+                (write (random-text) entropy-port)
+                (force-output entropy-port)
+                (guard (c ((nix-protocol-error? c)
+                           (pk 'determinism-exception c)
+                           (and (not (zero? (nix-protocol-error-status c)))
+                                (string-contains (nix-protocol-error-message c)
+                                                 "deterministic"))))
+                  ;; This one will produce a different result.  Since we're in
+                  ;; 'check' mode, this must fail.
+                  (build-things store (list (derivation-file-name drv))
+                                (build-mode check))
+                  #f))))))))
+
 (test-equal "store-lower"
   "Lowered."
   (let* ((add  (store-lower text-file))