diff options
author | Ludovic Courtès <ludo@gnu.org> | 2021-01-15 14:01:51 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2021-01-15 14:06:13 +0100 |
commit | 9621809ce8d984fff6421cb55fc851a24954be06 (patch) | |
tree | 747e9e26dff54e25da04d6ef45f452ef17b14884 | |
parent | f8281090d4b61b5bf9a351d2f86db1cd7e267e4c (diff) |
build-system/gnu: Really ignore the return value of phases.
This is a followup to 04baa011e9122205009d6d5f15b8162bf6f3fb8a.
* guix/build/gnu-build-system.scm (gnu-build): Really ignore the return
value of PROC. Wrap PROC call in 'with-throw-handler'. Add
'end-of-phase' procedure and use it.
-rw-r--r-- | guix/build/gnu-build-system.scm | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/guix/build/gnu-build-system.scm b/guix/build/gnu-build-system.scm index e556457db9..f8e8a46854 100644 --- a/guix/build/gnu-build-system.scm +++ b/guix/build/gnu-build-system.scm @@ -887,14 +887,27 @@ in order. Return #t if all the PHASES succeeded, #f otherwise." (for-each (match-lambda ((name . proc) (let ((start (current-time time-monotonic))) + (define (end-of-phase success?) + (let ((end (current-time time-monotonic))) + (format #t "phase `~a' ~:[failed~;succeeded~] after ~,1f seconds~%" + name success? + (elapsed-time end start)) + + ;; Dump the environment variables as a shell script, + ;; for handy debugging. + (system "export > $NIX_BUILD_TOP/environment-variables"))) + (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)) - - ;; Dump the environment variables as a shell script, for handy debugging. - (system "export > $NIX_BUILD_TOP/environment-variables") - result)))) + (with-throw-handler #t + (lambda () + (apply proc args) + (end-of-phase #t)) + (lambda args + ;; This handler executes before the stack is unwound. + ;; The exception is automatically re-thrown from here, + ;; and we should get a proper backtrace. + (format (current-error-port) + "error: in phase '~a': uncaught exception: +~{~s ~}~%" name args) + (end-of-phase #f)))))) phases))) |