ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

guix build: Set the build options early.

Browse source 
This fixes a bug whereby, with grafts leading to builds very early,
build options such as --substitute-urls would not be taken into account
yet.

Reported by Andreas Enge <andreas@enge.fr>.

* guix/scripts/build.scm (guix-build): Move 'opts' to the beginning.
Use 'with-store' instead of 'open-connection'.  Call
'set-build-options-from-command-line' right after 'with-store'.
This commit is contained in:
Ludovic Courtès 2016-03-04 17:50:30 +01:00
parent eda0522aab
commit c8f9f24776
1 changed files with 50 additions and 46 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
guix/scripts/build.scm
View file

@ -634,55 +634,59 @@ (define (show-build-log store file urls)
;;;
(define (guix-build . args)
(define opts
(parse-command-line args %options
(list %default-options)))
(with-error-handling
;; Ask for absolute file names so that .drv file names passed from the
;; user to 'read-derivation' are absolute when it returns.
(with-fluids ((%file-port-name-canonicalization 'absolute))
(let* ((opts (parse-command-line args %options
(list %default-options)))
(store (open-connection))
(mode (assoc-ref opts 'build-mode))
(drv (options->derivations store opts))
(urls (map (cut string-append <> "/log")
(if (assoc-ref opts 'substitutes?)
(or (assoc-ref opts 'substitute-urls)
;; XXX: This does not necessarily match the
;; daemon's substitute URLs.
%default-substitute-urls)
'())))
(items (filter-map (match-lambda
(('argument . (? store-path? file))
file)
(_ #f))
opts))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
(with-store store
;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts)
(unless (assoc-ref opts 'log-file?)
(show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?)
#:mode mode))
(cond ((assoc-ref opts 'log-file?)
(for-each (cut show-build-log store <> urls)
(delete-duplicates
(append (map derivation-file-name drv)
items))))
((assoc-ref opts 'derivations-only?)
(format #t "~{~a~%~}" (map derivation-file-name drv))
(for-each (cut register-root store <> <>)
(map (compose list derivation-file-name) drv)
roots))
((not (assoc-ref opts 'dry-run?))
(and (build-derivations store drv mode)
(for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>)
(map (lambda (drv)
(map cdr
(derivation->output-paths drv)))
drv)
roots))))))))
(let* ((mode (assoc-ref opts 'build-mode))
(drv (options->derivations store opts))
(urls (map (cut string-append <> "/log")
(if (assoc-ref opts 'substitutes?)
(or (assoc-ref opts 'substitute-urls)
;; XXX: This does not necessarily match the
;; daemon's substitute URLs.
%default-substitute-urls)
'())))
(items (filter-map (match-lambda
(('argument . (? store-path? file))
file)
(_ #f))
opts))
(roots (filter-map (match-lambda
(('gc-root . root) root)
(_ #f))
opts)))
(unless (assoc-ref opts 'log-file?)
(show-what-to-build store drv
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?)
#:mode mode))
(cond ((assoc-ref opts 'log-file?)
(for-each (cut show-build-log store <> urls)
(delete-duplicates
(append (map derivation-file-name drv)
items))))
((assoc-ref opts 'derivations-only?)
(format #t "~{~a~%~}" (map derivation-file-name drv))
(for-each (cut register-root store <> <>)
(map (compose list derivation-file-name) drv)
roots))
((not (assoc-ref opts 'dry-run?))
(and (build-derivations store drv mode)
(for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>)
(map (lambda (drv)
(map cdr
(derivation->output-paths drv)))
drv)
roots)))))))))