summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-01-29 11:00:42 +0100
committerLudovic Courtès <ludo@gnu.org>2019-01-29 11:00:42 +0100
commitf380f9d55e6757c242acf6c71c4a3ccfcdb066b2 (patch)
tree0ae5a477793ae1b93ba813761d457e78a8355b62
parent782f1ea9f693639b8feb3152fa6a280356ab1167 (diff)
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?'.
-rw-r--r--guix/build/gnu-build-system.scm43
-rw-r--r--guix/build/utils.scm17
2 files changed, 40 insertions, 20 deletions
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 7d92b8d72e..3f68ad52ed 100644
--- a/guix/build/gnu-build-system.scm
+++ b/guix/build/gnu-build-system.scm
@@ -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))
-
- ;; Issue a warning unless the result is #t.
- (unless (eqv? result #t)
- (format (current-error-port) "\
+ (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) "\
## 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)))
diff --git a/guix/build/utils.scm b/guix/build/utils.scm
index a21dbb0128..55d34b67e7 100644
--- a/guix/build/utils.scm
+++ b/guix/build/utils.scm
@@ -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).