ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-27 04:59:27 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

graft: Fail when one of the threads raises an exception.

Browse source 
Fixes <http://bugs.gnu.org/23581>.

* guix/build/graft.scm (exit-on-exception): New procedure.
(rewrite-directory): Use it to wrap REWRITE-LEAF.
This commit is contained in:
Ludovic Courtès 2016-05-24 23:49:26 +02:00
parent 92ed837a1e
commit 007c20b61c
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/build/graft.scm
View file

@ -105,6 +105,19 @@ (define (rename-matching-files directory mapping)
(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,8 +160,12 @@ (define (rewrite-leaf file)
;; #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)
(exit-on-exception rewrite-leaf)
(find-files directory (const #t)
#:directories? #t))
(rename-matching-files output mapping))