From 007c20b61c84af11289f96d43374e2e688838a26 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 24 May 2016 23:49:26 +0200 Subject: graft: Fail when one of the threads raises an exception. Fixes . * guix/build/graft.scm (exit-on-exception): New procedure. (rewrite-directory): Use it to wrap REWRITE-LEAF. --- guix/build/graft.scm | 21 +++++++++++++++++++-- 1 file 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 . (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 -- cgit 1.4.1