summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-05-14 23:53:38 +0200
committerLudovic Courtès <ludo@gnu.org>2013-05-14 23:53:38 +0200
commit0332386251ba001c0b0ec65fbfa1c06b826c6e47 (patch)
tree376d6950c38ae2c0c212d1b47459e337b0b7bdc8
parent90a1e4b3033e4a17a4b05f51f046a0eaa697c95b (diff)
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'.
-rw-r--r--.dir-locals.el3
-rwxr-xr-xguix/scripts/substitute-binary.scm15
2 files changed, 16 insertions, 2 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
index c7dc86fffe..fc41d430b4 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -15,7 +15,8 @@
(eval . (put 'with-directory-excursion 'scheme-indent-function 1))
(eval . (put 'package '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)))
(texinfo-mode . ((indent-tabs-mode . nil)
(fill-column . 72))))
diff --git a/guix/scripts/substitute-binary.scm b/guix/scripts/substitute-binary.scm
index 5965e936f9..27a43b9e3f 100755
--- a/guix/scripts/substitute-binary.scm
+++ b/guix/scripts/substitute-binary.scm
@@ -84,6 +84,18 @@ output port, and PROC's result is returned."
(lambda (key . args)
(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)
"Read recutils-style record from PORT and return them as a list of key/value
pairs."
@@ -94,7 +106,8 @@ pairs."
(result '()))
(cond ((eof-object? line)
(reverse result))
- ((regexp-exec field-rx line)
+ ((with-mutex %regexp-exec-mutex
+ (regexp-exec field-rx line))
=>
(lambda (match)
(loop (read-line port)