summaryrefslogtreecommitdiff
path: root/guix/build
diff options
context:
space:
mode:
authorMarius Bakke <mbakke@fastmail.com>2018-05-06 15:56:24 +0200
committerMarius Bakke <mbakke@fastmail.com>2018-05-06 15:56:24 +0200
commit12bd588346f8b2fb3709acfe0ee89d153da2db34 (patch)
tree459d8eb13a0508170ba462fe61a8b45fb55ea79f /guix/build
parent7d5adf013127c89826e9fbe9f1a67265b3538609 (diff)
parent8e020519b45bbdb9403164bd4403f2465bac99ad (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build')
-rw-r--r--guix/build/compile.scm45
-rw-r--r--guix/build/emacs-utils.scm4
2 files changed, 38 insertions, 11 deletions
diff --git a/guix/build/compile.scm b/guix/build/compile.scm
index 1bd8c60fe5..7b6e31107c 100644
--- a/guix/build/compile.scm
+++ b/guix/build/compile.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer <taylanbayirli@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -120,6 +120,28 @@ front."
(lambda ()
(set! path initial-value)))))
+(define (call/exit-on-exception thunk)
+ "Evaluate THUNK and exit right away if an exception is thrown."
+ (catch #t
+ thunk
+ (const #f)
+ (lambda (key . args)
+ (false-if-exception
+ ;; Duplicate stderr to avoid thread-safety issues.
+ (let* ((port (duplicate-port (current-error-port) "w0"))
+ (stack (make-stack #t))
+ (depth (stack-length stack))
+ (frame (and (> depth 1) (stack-ref stack 1))))
+ (false-if-exception (display-backtrace stack port))
+ (print-exception port frame key args)))
+
+ ;; Don't go any further.
+ (primitive-exit 1))))
+
+(define-syntax-rule (exit-on-exception exp ...)
+ "Evaluate EXP and exit if an exception is thrown."
+ (call/exit-on-exception (lambda () exp ...)))
+
(define* (compile-files source-directory build-directory files
#:key
(host %host-type)
@@ -139,15 +161,18 @@ files are for HOST, a GNU triplet such as \"x86_64-linux-gnu\"."
(define (build file)
(with-mutex progress-lock
(report-compilation file total completed))
- (with-fluids ((*current-warning-prefix* ""))
- (with-target host
- (lambda ()
- (let ((relative (relative-file source-directory file)))
- (compile-file file
- #:output-file (string-append build-directory "/"
- (scm->go relative))
- #:opts (append warning-options
- (optimization-options relative)))))))
+
+ ;; Exit as soon as something goes wrong.
+ (exit-on-exception
+ (with-fluids ((*current-warning-prefix* ""))
+ (with-target host
+ (lambda ()
+ (let ((relative (relative-file source-directory file)))
+ (compile-file file
+ #:output-file (string-append build-directory "/"
+ (scm->go relative))
+ #:opts (append warning-options
+ (optimization-options relative))))))))
(with-mutex progress-lock
(set! completed (+ 1 completed))))
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index c1b00c7890..fdacd30dd6 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -60,7 +60,9 @@
(define* (emacs-byte-compile-directory dir)
"Byte compile all files in DIR and its sub-directories."
- (let ((expr `(byte-recompile-directory (file-name-as-directory ,dir) 0)))
+ (let ((expr `(progn
+ (setq byte-compile-debug t) ; for proper exit status
+ (byte-recompile-directory (file-name-as-directory ,dir) 0 1))))
(emacs-batch-eval expr)))
(define-syntax emacs-substitute-sexps