02/11: build: Report build errors via 'report-load-error'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit ee700da584370330331ed09eabafc94a19892784
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jun 25 15:00:36 2019 +0200

    build: Report build errors via 'report-load-error'.
    
    * build-aux/compile-all.scm: Wrap 'compile-files' call in 'catch'.
    Attempt to resort to 'report-load-error' in (guix ui) to print the
    error.
---
 build-aux/compile-all.scm | 59 +++++++++++++++++++++++++++++++++--------------
 1 file changed, 42 insertions(+), 17 deletions(-)

diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
index 4259ea5..e9f3e95 100644
--- a/build-aux/compile-all.scm
+++ b/build-aux/compile-all.scm
@@ -91,20 +91,45 @@ to 'make'."
 
 (match (command-line)
   ((_ . files)
-   (compile-files srcdir (getcwd)
-                  (filter file-needs-compilation? files)
-                  #:workers (parallel-job-count)
-                  #:host host
-                  #:report-load (lambda (file total completed)
-                                  (when file
-                                    (format #t "[~3d%] LOAD     ~a~%"
-                                            (% (+ 1 completed) (* 2 total))
-                                            file)
-                                    (force-output)))
-                  #:report-compilation (lambda (file total completed)
-                                         (when file
-                                           (format #t "[~3d%] GUILEC   ~a~%"
-                                                   (% (+ total completed 1)
-                                                      (* 2 total))
-                                                   (scm->go file))
-                                           (force-output))))))
+   (catch #t
+     (lambda ()
+       (compile-files srcdir (getcwd)
+                      (filter file-needs-compilation? files)
+                      #:workers (parallel-job-count)
+                      #:host host
+                      #:report-load (lambda (file total completed)
+                                      (when file
+                                        (format #t "[~3d%] LOAD     ~a~%"
+                                                (% (+ 1 completed) (* 2 total))
+                                                file)
+                                        (force-output)))
+                      #:report-compilation (lambda (file total completed)
+                                             (when file
+                                               (format #t "[~3d%] GUILEC   
~a~%"
+                                                       (% (+ total completed 1)
+                                                          (* 2 total))
+                                                       (scm->go file))
+                                               (force-output)))))
+     (lambda _
+       (primitive-exit 1))
+     (lambda args
+       ;; Try to report the error in an intelligible way.
+       (let* ((stack   (make-stack #t))
+              (frame   (if (> (stack-length stack) 1)
+                           (stack-ref stack 1)    ;skip the 'throw' frame
+                           (stack-ref stack 0)))
+              (ui      (false-if-exception
+                        (resolve-module '(guix ui))))
+              (report  (and ui
+                            (false-if-exception
+                             (module-ref ui 'report-load-error)))))
+         (if report
+             ;; In Guile <= 2.2.5, 'current-load-port' was not exported.
+             (let ((load-port ((module-ref (resolve-module '(ice-9 ports))
+                                           'current-load-port))))
+               (report (or (and=> load-port port-filename) "?.scm")
+                       args frame))
+             (begin
+               (print-exception (current-error-port) frame
+                                (car args) (cdr args))
+               (display-backtrace stack (current-error-port)))))))))