aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/serialization.scm12
-rw-r--r--guix/store.scm16
-rw-r--r--tests/derivations.scm14
3 files changed, 34 insertions, 8 deletions
diff --git a/guix/serialization.scm b/guix/serialization.scm
index 474dc69de5..284b174794 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -22,11 +22,13 @@
#:use-module (rnrs io ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
#:export (write-int read-int
write-long-long read-long-long
write-padding
write-string read-string read-latin1-string
write-string-list read-string-list
+ write-string-pairs
write-store-path read-store-path
write-store-path-list read-store-path-list))
@@ -94,6 +96,14 @@
(write-int (length l) p)
(for-each (cut write-string <> p) l))
+(define (write-string-pairs l p)
+ (write-int (length l) p)
+ (for-each (match-lambda
+ ((first . second)
+ (write-string first p)
+ (write-string second p)))
+ l))
+
(define (read-string-list p)
(let ((len (read-int p)))
(unfold (cut >= <> len)
diff --git a/guix/store.scm b/guix/store.scm
index 75edb340ae..909ef195de 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -197,7 +197,7 @@
result))))))
(define-syntax write-arg
- (syntax-rules (integer boolean file string string-list
+ (syntax-rules (integer boolean file string string-list string-pairs
store-path store-path-list base16)
((_ integer arg p)
(write-int arg p))
@@ -209,6 +209,8 @@
(write-string arg p))
((_ string-list arg p)
(write-string-list arg p))
+ ((_ string-pairs arg p)
+ (write-string-pairs arg p))
((_ store-path arg p)
(write-store-path arg p))
((_ store-path-list arg p)
@@ -430,6 +432,7 @@ encoding conversion errors."
#:key keep-failed? keep-going? fallback?
(verbosity 0)
(max-build-jobs (current-processor-count))
+ timeout
(max-silent-time 3600)
(use-build-hook? #t)
(build-verbosity 0)
@@ -462,12 +465,11 @@ encoding conversion errors."
(when (>= (nix-server-minor-version server) 10)
(send (boolean use-substitutes?)))
(when (>= (nix-server-minor-version server) 12)
- (send (string-list (fold-right (lambda (pair result)
- (match pair
- ((h . t)
- (cons* h t result))))
- '()
- binary-caches))))
+ (let ((pairs (if timeout
+ `(("build-timeout" . ,(number->string timeout))
+ ,@binary-caches)
+ binary-caches)))
+ (send (string-pairs pairs))))
(let loop ((done? (process-stderr server)))
(or done? (process-stderr server)))))
diff --git a/tests/derivations.scm b/tests/derivations.scm
index f31b00b8a2..e87662a198 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -446,6 +446,20 @@
(build-derivations store (list drv))
#f)))
+(test-assert "build-expression->derivation and timeout"
+ (let* ((store (let ((s (open-connection)))
+ (set-build-options s #:timeout 1)
+ s))
+ (builder '(begin (sleep 100) (mkdir %output) #t))
+ (drv (build-expression->derivation store "slow" builder))
+ (out-path (derivation->output-path drv)))
+ (guard (c ((nix-protocol-error? c)
+ (and (string-contains (nix-protocol-error-message c)
+ "failed")
+ (not (valid-path? store out-path)))))
+ (build-derivations store (list drv))
+ #f)))
+
(test-assert "build-expression->derivation and derivation-prerequisites-to-build"
(let ((drv (build-expression->derivation %store "fail" #f)))
;; The only direct dependency is (%guile-for-build) and it's already