diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2014-03-09 23:01:18 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2014-03-09 23:01:18 +0100 |
| commit | 6c20d1d0c3822c0332f3cca963121365133e6412 (patch) | |
| tree | fdb2c7c0d1c68376541e2d507bf98a72031fa9c1 /guix/store.scm | |
| parent | 02c86a5e365f59fb09c32cfaaef2c02db17e8770 (diff) | |
| download | gnu-guix-6c20d1d0c3822c0332f3cca963121365133e6412.tar gnu-guix-6c20d1d0c3822c0332f3cca963121365133e6412.tar.gz | |
store: Add #:timeout build option.
* guix/serialization.scm (write-string-pairs): New procedure.
* guix/store.scm (write-arg): Add 'string-pairs' case.
(set-build-options): Add 'timeout' keyword parameter. Honor it.
* tests/derivations.scm ("build-expression->derivation and timeout"):
New test.
Diffstat (limited to 'guix/store.scm')
| -rw-r--r-- | guix/store.scm | 16 |
1 files changed, 9 insertions, 7 deletions
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))))) |