build-system/gnu: Report invocation errors in a human-friendly way.
* guix/build/utils.scm (report-invoke-error): New procedure. * guix/build/gnu-build-system.scm (gnu-build): Guard against 'invoke-error?'.master
parent
782f1ea9f6
commit
f380f9d55e
|
@ -790,28 +790,31 @@ in order. Return #t if all the PHASES succeeded, #f otherwise."
|
|||
;; Encoding/decoding errors shouldn't be silent.
|
||||
(fluid-set! %default-port-conversion-strategy 'error)
|
||||
|
||||
;; The trick is to #:allow-other-keys everywhere, so that each procedure in
|
||||
;; PHASES can pick the keyword arguments it's interested in.
|
||||
(every (match-lambda
|
||||
((name . proc)
|
||||
(let ((start (current-time time-monotonic)))
|
||||
(format #t "starting phase `~a'~%" name)
|
||||
(let ((result (apply proc args))
|
||||
(end (current-time time-monotonic)))
|
||||
(format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
|
||||
name result
|
||||
(elapsed-time end start))
|
||||
(guard (c ((invoke-error? c)
|
||||
(report-invoke-error c)
|
||||
(exit 1)))
|
||||
;; The trick is to #:allow-other-keys everywhere, so that each procedure in
|
||||
;; PHASES can pick the keyword arguments it's interested in.
|
||||
(every (match-lambda
|
||||
((name . proc)
|
||||
(let ((start (current-time time-monotonic)))
|
||||
(format #t "starting phase `~a'~%" name)
|
||||
(let ((result (apply proc args))
|
||||
(end (current-time time-monotonic)))
|
||||
(format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
|
||||
name result
|
||||
(elapsed-time end start))
|
||||
|
||||
;; Issue a warning unless the result is #t.
|
||||
(unless (eqv? result #t)
|
||||
(format (current-error-port) "\
|
||||
;; Issue a warning unless the result is #t.
|
||||
(unless (eqv? result #t)
|
||||
(format (current-error-port) "\
|
||||
## WARNING: phase `~a' returned `~s'. Return values other than #t
|
||||
## are deprecated. Please migrate this package so that its phase
|
||||
## procedures report errors by raising an exception, and otherwise
|
||||
## always return #t.~%"
|
||||
name result))
|
||||
name result))
|
||||
|
||||
;; Dump the environment variables as a shell script, for handy debugging.
|
||||
(system "export > $NIX_BUILD_TOP/environment-variables")
|
||||
result))))
|
||||
phases))
|
||||
;; Dump the environment variables as a shell script, for handy debugging.
|
||||
(system "export > $NIX_BUILD_TOP/environment-variables")
|
||||
result))))
|
||||
phases)))
|
||||
|
|
|
@ -98,6 +98,7 @@
|
|||
invoke-error-exit-status
|
||||
invoke-error-term-signal
|
||||
invoke-error-stop-signal
|
||||
report-invoke-error
|
||||
|
||||
locale-category->string))
|
||||
|
||||
|
@ -622,6 +623,11 @@ Where every <*-phase-name> is an expression evaluating to a symbol, and
|
|||
((_ phases (add-after old-phase-name new-phase-name new-phase))
|
||||
(alist-cons-after old-phase-name new-phase-name new-phase phases))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Program invocation.
|
||||
;;;
|
||||
|
||||
(define-condition-type &invoke-error &error
|
||||
invoke-error?
|
||||
(program invoke-error-program)
|
||||
|
@ -643,6 +649,17 @@ if the exit code is non-zero; otherwise return #t."
|
|||
(stop-signal (status:stop-sig code))))))
|
||||
#t))
|
||||
|
||||
(define* (report-invoke-error c #:optional (port (current-error-port)))
|
||||
"Report to PORT about C, an '&invoke-error' condition, in a human-friendly
|
||||
way."
|
||||
(format port "command~{ ~s~} failed with ~:[signal~;status~] ~a~%"
|
||||
(cons (invoke-error-program c)
|
||||
(invoke-error-arguments c))
|
||||
(invoke-error-exit-status c)
|
||||
(or (invoke-error-exit-status c)
|
||||
(invoke-error-term-signal c)
|
||||
(invoke-error-stop-signal c))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Text substitution (aka. sed).
|
||||
|
|
Reference in New Issue