summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2019-06-25 15:00:36 +0200
committerLudovic Courtès <ludo@gnu.org>2019-06-25 17:41:24 +0200
commitee700da584370330331ed09eabafc94a19892784 (patch)
tree4df873265f4c4b50c0ce7952dcde213349d53fd1
parent77c2899cd409d0bafecf2253b1656487da09adc0 (diff)
downloadguix-ee700da584370330331ed09eabafc94a19892784.tar.gz
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.
-rw-r--r--build-aux/compile-all.scm59
1 files changed, 42 insertions, 17 deletions
diff --git a/build-aux/compile-all.scm b/build-aux/compile-all.scm
index 4259ea523c..e9f3e957d9 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)))))))))