substitute-binary: Work around thread-unsafe `regexp-exec'.
* guix/scripts/substitute-binary.scm (%regexp-exec-mutex): New variable. (string->uri): New procedure. (fields->alist): Wrap `regexp-exec' call in `with-mutex'.
This commit is contained in:
parent
90a1e4b303
commit
0332386251
|
@ -15,7 +15,8 @@
|
||||||
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
|
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
|
||||||
(eval . (put 'package 'scheme-indent-function 1))
|
(eval . (put 'package 'scheme-indent-function 1))
|
||||||
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
|
(eval . (put 'substitute-keyword-arguments 'scheme-indent-function 1))
|
||||||
(eval . (put 'with-error-handling 'scheme-indent-function 0))))
|
(eval . (put 'with-error-handling 'scheme-indent-function 0))
|
||||||
|
(eval . (put 'with-mutex 'scheme-indent-function 1))))
|
||||||
(emacs-lisp-mode . ((indent-tabs-mode . nil)))
|
(emacs-lisp-mode . ((indent-tabs-mode . nil)))
|
||||||
(texinfo-mode . ((indent-tabs-mode . nil)
|
(texinfo-mode . ((indent-tabs-mode . nil)
|
||||||
(fill-column . 72))))
|
(fill-column . 72))))
|
||||||
|
|
|
@ -84,6 +84,18 @@ output port, and PROC's result is returned."
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
(false-if-exception (delete-file template))))))
|
(false-if-exception (delete-file template))))))
|
||||||
|
|
||||||
|
(define %regexp-exec-mutex
|
||||||
|
;; In Guile 2.0.9, `regexp-exec' is thread-unsafe, so work around it.
|
||||||
|
;; See <http://bugs.gnu.org/14404>.
|
||||||
|
(make-mutex))
|
||||||
|
|
||||||
|
(define string->uri
|
||||||
|
(let ((real (@ (web uri) string->uri)))
|
||||||
|
(lambda (uri)
|
||||||
|
"A thread-safe `string->uri'."
|
||||||
|
(with-mutex %regexp-exec-mutex
|
||||||
|
(real uri)))))
|
||||||
|
|
||||||
(define (fields->alist port)
|
(define (fields->alist port)
|
||||||
"Read recutils-style record from PORT and return them as a list of key/value
|
"Read recutils-style record from PORT and return them as a list of key/value
|
||||||
pairs."
|
pairs."
|
||||||
|
@ -94,7 +106,8 @@ pairs."
|
||||||
(result '()))
|
(result '()))
|
||||||
(cond ((eof-object? line)
|
(cond ((eof-object? line)
|
||||||
(reverse result))
|
(reverse result))
|
||||||
((regexp-exec field-rx line)
|
((with-mutex %regexp-exec-mutex
|
||||||
|
(regexp-exec field-rx line))
|
||||||
=>
|
=>
|
||||||
(lambda (match)
|
(lambda (match)
|
||||||
(loop (read-line port)
|
(loop (read-line port)
|
||||||
|
|
Loading…
Reference in New Issue