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:
Ludovic Courtès 2013-05-14 23:53:38 +02:00
parent 90a1e4b303
commit 0332386251
2 changed files with 16 additions and 2 deletions

View File

@ -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))))

View File

@ -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)