me
/
guix
Archived
1
0
Fork 0
Code

guix build: Use 'with-build-handler'. 

Fixes <https://bugs.gnu.org/28310>.
Reported by Andreas Enge <andreas@enge.fr>.

* guix/scripts/build.scm (guix-build): Wrap 'parameterize' in
'with-build-handler'.  Remove explicit call to 'show-what-to-build'.
Call 'build-derivations' regardless of whether OPTS contains 'dry-run?'.
master
Ludovic Courtès 2020-03-18 22:46:39 +01:00
parent 07ce23e011
commit 62195b9a8f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 55 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
guix/scripts/build.scm
View File

@ -952,64 +952,60 @@ needed."
;; Set the build options before we do anything else. ;; Set the build options before we do anything else.
(set-build-options-from-command-line store opts) (set-build-options-from-command-line store opts)
(parameterize ((current-terminal-columns (terminal-columns)) (with-build-handler (build-notifier #:use-substitutes?
(assoc-ref opts 'substitutes?)
#:dry-run?
(assoc-ref opts 'dry-run?))
(parameterize ((current-terminal-columns (terminal-columns))
;; Set grafting upfront in case the user's input ;; Set grafting upfront in case the user's input
;; depends on it (e.g., a manifest or code snippet that ;; depends on it (e.g., a manifest or code snippet that
;; calls 'gexp->derivation'). ;; calls 'gexp->derivation').
(%graft? graft?)) (%graft? graft?))
(let* ((mode (assoc-ref opts 'build-mode)) (let* ((mode (assoc-ref opts 'build-mode))
(drv (options->derivations store opts)) (drv (options->derivations store opts))
(urls (map (cut string-append <> "/log") (urls (map (cut string-append <> "/log")
(if (assoc-ref opts 'substitutes?) (if (assoc-ref opts 'substitutes?)
(or (assoc-ref opts 'substitute-urls) (or (assoc-ref opts 'substitute-urls)
;; XXX: This does not necessarily match the ;; XXX: This does not necessarily match the
;; daemon's substitute URLs. ;; daemon's substitute URLs.
%default-substitute-urls) %default-substitute-urls)
'()))) '())))
(items (filter-map (match-lambda (items (filter-map (match-lambda
(('argument . (? store-path? file)) (('argument . (? store-path? file))
;; If FILE is a .drv that's not in ;; If FILE is a .drv that's not in
;; store, keep it so that it can be ;; store, keep it so that it can be
;; substituted. ;; substituted.
(and (or (not (derivation-path? file)) (and (or (not (derivation-path? file))
(not (file-exists? file))) (not (file-exists? file)))
file)) file))
(_ #f)) (_ #f))
opts)) opts))
(roots (filter-map (match-lambda (roots (filter-map (match-lambda
(('gc-root . root) root) (('gc-root . root) root)
(_ #f)) (_ #f))
opts))) opts)))
(unless (or (assoc-ref opts 'log-file?) (cond ((assoc-ref opts 'log-file?)
(assoc-ref opts 'derivations-only?)) ;; Pass 'show-build-log' the output file names, not the
(show-what-to-build store drv ;; derivation file names, because there can be several
#:use-substitutes? ;; derivations leading to the same output.
(assoc-ref opts 'substitutes?) (for-each (cut show-build-log store <> urls)
#:dry-run? (assoc-ref opts 'dry-run?) (delete-duplicates
#:mode mode)) (append (map derivation->output-path drv)
items))))
(cond ((assoc-ref opts 'log-file?) ((assoc-ref opts 'derivations-only?)
;; Pass 'show-build-log' the output file names, not the (format #t "~{~a~%~}" (map derivation-file-name drv))
;; derivation file names, because there can be several (for-each (cut register-root store <> <>)
;; derivations leading to the same output. (map (compose list derivation-file-name) drv)
(for-each (cut show-build-log store <> urls) roots))
(delete-duplicates (else
(append (map derivation->output-path drv) (and (build-derivations store (append drv items)
items)))) mode)
((assoc-ref opts 'derivations-only?) (for-each show-derivation-outputs drv)
(format #t "~{~a~%~}" (map derivation-file-name drv)) (for-each (cut register-root store <> <>)
(for-each (cut register-root store <> <>) (map (lambda (drv)
(map (compose list derivation-file-name) drv) (map cdr
roots)) (derivation->output-paths drv)))
((not (assoc-ref opts 'dry-run?)) drv)
(and (build-derivations store (append drv items) roots)))))))))))
mode)
(for-each show-derivation-outputs drv)
(for-each (cut register-root store <> <>)
(map (lambda (drv)
(map cdr
(derivation->output-paths drv)))
drv)
roots))))))))))