02/02: build-system/gnu: Report invocation errors in a human-friendly way.

[guix-commits]

civodul pushed a commit to branch core-updates
in repository guix.

commit f380f9d55e6757c242acf6c71c4a3ccfcdb066b2
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jan 29 11:00:42 2019 +0100

    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?'.
---
 guix/build/gnu-build-system.scm | 43 ++++++++++++++++++++++-------------------
 guix/build/utils.scm            | 17 ++++++++++++++++
 2 files changed, 40 insertions(+), 20 deletions(-)

diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm
index 7d92b8d..3f68ad5 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 a21dbb0..55d34b6 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).