Browse Source

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.
gn-latest-20200428
Ludovic Courtès 7 years ago
parent
commit
6c20d1d0c3
3 changed files with 34 additions and 8 deletions
  1. +11
    -1
      guix/serialization.scm
  2. +9
    -7
      guix/store.scm
  3. +14
    -0
      tests/derivations.scm

+ 11
- 1
guix/serialization.scm View File

@@ -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)


+ 9
- 7
guix/store.scm View File

@@ -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)))))



+ 14
- 0
tests/derivations.scm View File

@@ -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


Loading…
Cancel
Save