diff options
author | Andy Wingo <wingo@pobox.com> | 2011-04-11 23:30:52 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-04-11 23:30:52 +0200 |
commit | 21c05db45b69f8a62b84c36abc86cb935fa967d7 (patch) | |
tree | 743df01da540e7fd628f54894e7d5fbe94b03996 /module/system/base/compile.scm | |
parent | 4db853d747ac115f799c93e2de93f5159ad84109 (diff) | |
parent | c89b45299329d034875429804f18768c1ea96713 (diff) | |
download | guile-21c05db45b69f8a62b84c36abc86cb935fa967d7.tar.gz |
Merge remote branch 'origin/stable-2.0'
Conflicts:
GUILE-VERSION
test-suite/tests/srfi-4.test
Diffstat (limited to 'module/system/base/compile.scm')
-rw-r--r-- | module/system/base/compile.scm | 29 |
1 files changed, 20 insertions, 9 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm index 7d46713b2..1b6e73f32 100644 --- a/module/system/base/compile.scm +++ b/module/system/base/compile.scm @@ -68,16 +68,27 @@ x (lookup-language x))) -;; Throws an exception if `dir' is not writable. The double-stat is OK, -;; as this is only used during compilation. +;; Throws an exception if `dir' is not writable. The mkdir occurs +;; before the check, so that we avoid races (possibly due to parallel +;; compilation). +;; (define (ensure-writable-dir dir) - (if (file-exists? dir) - (if (access? dir W_OK) - #t - (error "directory not writable" dir)) - (begin - (ensure-writable-dir (dirname dir)) - (mkdir dir)))) + (catch 'system-error + (lambda () + (mkdir dir)) + (lambda (k subr fmt args rest) + (let ((errno (and (pair? rest) (car rest)))) + (cond + ((eqv? errno EEXIST) + (let ((st (stat dir))) + (if (or (not (eq? (stat:type st) 'directory)) + (not (access? dir W_OK))) + (error "directory not writable" dir)))) + ((eqv? errno ENOENT) + (ensure-writable-dir (dirname dir)) + (ensure-writable-dir dir)) + (else + (throw k subr fmt args rest))))))) ;;; This function is among the trickiest I've ever written. I tried many ;;; variants. In the end, simple is best, of course. |