ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-23 21:17:11 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Add missing `set-build-options' parameters.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2012-07-01 00:09:47 +02:00
parent 6b1891b0a1
commit e036c31bc6
1 changed files with 18 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
guix/store.scm
View file

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