diff options
| -rw-r--r-- | guix/serialization.scm | 12 | ||||
| -rw-r--r-- | guix/store.scm | 16 | ||||
| -rw-r--r-- | tests/derivations.scm | 14 |
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 |