Issue 5100: Prevent race condition in font export directory making

When a font export directory is necessary,
LilyPond tested the existence of the directory,
and if the directory did not exist, LilyPond made the directory.
However, LilyPond raised the error that the directory already exists
if another process made the directory between the testing and the making.

This commit prevents such race condition.
By deleting the existence test,
LilyPond always tries to make the directory regardless of existence.
Then suppress the error that the directory already exists.

diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index aee522e0fa7e53b55101b7f14350d7d27fe2eeaa..9498b2ac9dd24bff298a593707e53a9862b57609 100644 (file)
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -538,13 +538,22 @@
   (set! never-embed-font-list (list))
   (if (ly:get-option 'font-export-dir)
       (let ((dirname (format #f "~a" (ly:get-option 'font-export-dir))))
-        (if (file-exists? dirname)
-            (ly:debug
-             (_ "Font export directory `~a' already exists.") dirname)
-            (begin
-              (ly:debug
-               (_ "Making font export directory `~a'.") dirname)
-              (mkdir dirname)))))
+        (ly:debug
+         (_ "Making font export directory `~a'.") dirname)
+        (catch
+         'system-error
+         (lambda ()
+           ;; mkdir:
+           ;; When the directory already exists, it raises system-error.
+           (mkdir dirname))
+         (lambda stuff
+           ;; Catch the system-error
+           (if (= EEXIST (system-error-errno stuff))
+               ;; If the directory already exists, avoid error.
+               (ly:debug
+                (_ "Font export directory `~a' already exists.") dirname)
+               ;; If the cause is something else, re-throw the error.
+               (throw 'system-error (cdr stuff)))))))
   (if load-fonts?
       (for-each (lambda (f)
                   (format port "\n%%BeginFont: ~a\n" (car f))