diff options
author | Ludovic Courtès <ludo@gnu.org> | 2016-06-07 11:54:03 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2016-06-07 11:54:03 +0200 |
commit | aeafff536f933b07836b14d089dfc52b0e432ec9 (patch) | |
tree | 4ede554999f98cf9e19c04098c934db52efae795 /guix/build/graft.scm | |
parent | 9dee9e8ffe4650949bd3ad2edf559cf4a33e9e6e (diff) | |
parent | f82c58539e1f7b9b864e68ea2ab0c6a17c15fbb5 (diff) | |
download | gnu-guix-aeafff536f933b07836b14d089dfc52b0e432ec9.tar gnu-guix-aeafff536f933b07836b14d089dfc52b0e432ec9.tar.gz |
Merge branch 'master' into core-updates
Diffstat (limited to 'guix/build/graft.scm')
-rw-r--r-- | guix/build/graft.scm | 21 |
1 files changed, 19 insertions, 2 deletions
diff --git a/guix/build/graft.scm b/guix/build/graft.scm index b61982dd64..fb21fc3af3 100644 --- a/guix/build/graft.scm +++ b/guix/build/graft.scm @@ -105,6 +105,19 @@ a list of store file name pairs." (string-append (dirname file) "/" target)))) matches))) +(define (exit-on-exception proc) + "Return a procedure that wraps PROC so that 'primitive-exit' is called when +an exception is caught." + (lambda (arg) + (catch #t + (lambda () + (proc arg)) + (lambda (key . args) + ;; Since ports are not thread-safe as of Guile 2.0, reopen stderr. + (let ((port (fdopen 2 "w0"))) + (print-exception port #f key args) + (primitive-exit 1)))))) + (define* (rewrite-directory directory output mapping #:optional (store (%store-directory))) "Copy DIRECTORY to OUTPUT, replacing strings according to MAPPING, a list of @@ -147,9 +160,13 @@ file name pairs." ;; #o777. (umask #o022) + ;; Use 'exit-on-exception' to force an exit upon I/O errors, given that + ;; 'n-par-for-each' silently swallows exceptions. + ;; See <http://bugs.gnu.org/23581>. (n-par-for-each (parallel-job-count) - rewrite-leaf (find-files directory (const #t) - #:directories? #t)) + (exit-on-exception rewrite-leaf) + (find-files directory (const #t) + #:directories? #t)) (rename-matching-files output mapping)) ;;; graft.scm ends here |