me
/
guix
Archived
1
0
Fork 0

Add missing `set-build-options' parameters.

* guix/store.scm (set-build-options)[build-cores, use-substitutes?]: New
  keyword parameters.
  [send]: Change to expect a type, and use `write-arg'.
  Send settings for BUILD-CORES and USE-SUBSTITUTES? when the server
  supports it.
master
Ludovic Courtès 2012-07-01 00:09:47 +02:00
parent 6b1891b0a1
commit e036c31bc6
1 changed files with 18 additions and 16 deletions

View File

@ -331,30 +331,32 @@ again until #t is returned or an error is raised."
(use-build-hook? #t) (use-build-hook? #t)
(build-verbosity 0) (build-verbosity 0)
(log-type 0) (log-type 0)
(print-build-trace #t)) (print-build-trace #t)
(build-cores 1)
(use-substitutes? #t))
;; Must be called after `open-connection'. ;; Must be called after `open-connection'.
(define socket (define socket
(nix-server-socket server)) (nix-server-socket server))
(let-syntax ((send (syntax-rules () (let-syntax ((send (syntax-rules ()
((_ option ...) ((_ (type option) ...)
(for-each (lambda (i) (begin
(cond ((boolean? i) (write-arg type option socket)
(write-int (if i 1 0) socket)) ...)))))
((integer? i) (write-int (operation-id set-options) socket)
(write-int i socket)) (send (boolean keep-failed?) (boolean keep-going?)
(else (boolean try-fallback?) (integer verbosity)
(error "invalid build option" (integer max-build-jobs) (integer max-silent-time))
i))))
(list option ...))))))
(send (operation-id set-options)
keep-failed? keep-going? try-fallback? verbosity
max-build-jobs max-silent-time)
(if (>= (nix-server-minor-version server) 2) (if (>= (nix-server-minor-version server) 2)
(send use-build-hook?)) (send (boolean use-build-hook?)))
(if (>= (nix-server-minor-version server) 4) (if (>= (nix-server-minor-version server) 4)
(send build-verbosity log-type print-build-trace)) (send (integer build-verbosity) (integer log-type)
(boolean print-build-trace)))
(if (>= (nix-server-minor-version server) 6)
(send (integer build-cores)))
(if (>= (nix-server-minor-version server) 10)
(send (boolean use-substitutes?)))
(let loop ((done? (process-stderr server))) (let loop ((done? (process-stderr server)))
(or done? (process-stderr server))))) (or done? (process-stderr server)))))