me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2019-06-25 15:00:36 +02:00
parent 77c2899cd4
commit ee700da584
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 42 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
build-aux/compile-all.scm
View File

@ -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)))))))))