From 814153001efd349e9f4444841c4a42aad91730b3 Mon Sep 17 00:00:00 2001 From: bdeket Date: Thu, 17 Apr 2025 14:58:45 +0200 Subject: [PATCH] with-cache: shared reads allow multiple processes to read cache at same time --- private/with-cache.rkt | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/private/with-cache.rkt b/private/with-cache.rkt index 1ca9c5b..5fa96c1 100644 --- a/private/with-cache.rkt +++ b/private/with-cache.rkt @@ -163,24 +163,23 @@ #f))) (define (call-with-atomic-input-file filename success-proc) - (call/atomic filename (λ () (call-with-input-file filename success-proc)))) + (call/atomic filename 'shared (λ () (call-with-input-file filename success-proc)))) (define (call-with-atomic-output-file filename success-proc) - (call/atomic filename (λ () (call-with-output-file filename success-proc #:exists 'replace)))) + (call/atomic filename 'exclusive (λ () (call-with-output-file filename success-proc #:exists 'replace)))) -(define (call/atomic filename success-thunk) +(define (call/atomic filename kind success-thunk) (define lockfile (make-lock-file-name (build-path (find-system-path 'temp-dir) (format "with-cache~a" (equal-hash-code filename))))) (call-with-file-lock/timeout filename - 'exclusive + kind success-thunk (λ () (raise (exn:fail:filesystem (format "with-cache: Failed to lock file '~a', delete the lock '~a' and try again." filename lockfile) (current-continuation-marks)))) #:lock-file lockfile)) - (define (parent-directory-exists? ps) (and (path-string? ps) (let ([dir (path-only ps)])