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?'.
This commit is contained in:
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.
|
;; Encoding/decoding errors shouldn't be silent.
|
||||||
(fluid-set! %default-port-conversion-strategy 'error)
|
(fluid-set! %default-port-conversion-strategy 'error)
|
||||||
|
|
||||||
;; The trick is to #:allow-other-keys everywhere, so that each procedure in
|
(guard (c ((invoke-error? c)
|
||||||
;; PHASES can pick the keyword arguments it's interested in.
|
(report-invoke-error c)
|
||||||
(every (match-lambda
|
(exit 1)))
|
||||||
((name . proc)
|
;; The trick is to #:allow-other-keys everywhere, so that each procedure in
|
||||||
(let ((start (current-time time-monotonic)))
|
;; PHASES can pick the keyword arguments it's interested in.
|
||||||
(format #t "starting phase `~a'~%" name)
|
(every (match-lambda
|
||||||
(let ((result (apply proc args))
|
((name . proc)
|
||||||
(end (current-time time-monotonic)))
|
(let ((start (current-time time-monotonic)))
|
||||||
(format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%"
|
(format #t "starting phase `~a'~%" name)
|
||||||
name result
|
(let ((result (apply proc args))
|
||||||
(elapsed-time end start))
|
(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.
|
;; Issue a warning unless the result is #t.
|
||||||
(unless (eqv? result #t)
|
(unless (eqv? result #t)
|
||||||
(format (current-error-port) "\
|
(format (current-error-port) "\
|
||||||
## WARNING: phase `~a' returned `~s'. Return values other than #t
|
## WARNING: phase `~a' returned `~s'. Return values other than #t
|
||||||
## are deprecated. Please migrate this package so that its phase
|
## are deprecated. Please migrate this package so that its phase
|
||||||
## procedures report errors by raising an exception, and otherwise
|
## procedures report errors by raising an exception, and otherwise
|
||||||
## always return #t.~%"
|
## always return #t.~%"
|
||||||
name result))
|
name result))
|
||||||
|
|
||||||
;; Dump the environment variables as a shell script, for handy debugging.
|
;; Dump the environment variables as a shell script, for handy debugging.
|
||||||
(system "export > $NIX_BUILD_TOP/environment-variables")
|
(system "export > $NIX_BUILD_TOP/environment-variables")
|
||||||
result))))
|
result))))
|
||||||
phases))
|
phases)))
|
||||||
|
|
|
@ -98,6 +98,7 @@
|
||||||
invoke-error-exit-status
|
invoke-error-exit-status
|
||||||
invoke-error-term-signal
|
invoke-error-term-signal
|
||||||
invoke-error-stop-signal
|
invoke-error-stop-signal
|
||||||
|
report-invoke-error
|
||||||
|
|
||||||
locale-category->string))
|
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))
|
((_ phases (add-after old-phase-name new-phase-name new-phase))
|
||||||
(alist-cons-after old-phase-name new-phase-name new-phase phases))))
|
(alist-cons-after old-phase-name new-phase-name new-phase phases))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Program invocation.
|
||||||
|
;;;
|
||||||
|
|
||||||
(define-condition-type &invoke-error &error
|
(define-condition-type &invoke-error &error
|
||||||
invoke-error?
|
invoke-error?
|
||||||
(program invoke-error-program)
|
(program invoke-error-program)
|
||||||
|
@ -643,6 +649,17 @@ if the exit code is non-zero; otherwise return #t."
|
||||||
(stop-signal (status:stop-sig code))))))
|
(stop-signal (status:stop-sig code))))))
|
||||||
#t))
|
#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).
|
;;; Text substitution (aka. sed).
|
||||||
|
|
Loading…
Reference in New Issue