suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

clean up the contract checking for call-with-file-lock/timeout

Browse Source
This commit is contained in:
Robby Findler 2011-08-10 21:20:59 -05:00
parent d12b617292
commit 78a999537d
2 changed files with 26 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
collects/racket/file.rkt
View File

@ -175,40 +175,41 @@
[else 'exists]))
(define (call-with-file-lock/timeout fn kind thunk failure-thunk
#:get-lock-file [get-lock-file (make-lock-file-name fn)]
#:delay [delay 0.01]
#:max-delay [max-delay 0.2])
#:get-lock-file [get-lock-file (λ () (make-lock-file-name fn))]
#:delay [delay 0.01]
#:max-delay [max-delay 0.2])
(unless (or (path-string? fn) (eq? fn #f))
(raise-type-error 'call-with-file-lock/timeout "path-string? or #f" fn))
(unless (or (eq? kind 'shared) (eq? kind 'exclusive))
(raise-type-error 'call-with-file-lock/timeout "'shared or 'exclusive" kind))
(unless (= (procedure-arity thunk) 0)
(unless (and (procedure? thunk) (= (procedure-arity thunk) 0))
(raise-type-error 'call-with-file-lock/timeout "procedure (arity 0)" thunk))
(unless (= (procedure-arity failure-thunk) 0)
(unless (and (procedure? thunk) (= (procedure-arity thunk) 0))
(raise-type-error 'call-with-file-lock/timeout "procedure (arity 0)" failure-thunk))
(unless (or (path-string? get-lock-file)
(= (procedure-arity get-lock-file) 0))
(raise-type-error 'call-with-file-lock/timeout "procedure (arity 0)" get-lock-file))
(and (procedure? get-lock-file) (= (procedure-arity get-lock-file) 0)))
(raise-type-error 'call-with-file-lock/timeout "procedure (arity 0) returning a path-string? or path-string?" get-lock-file))
(unless (and (real? delay) (not (negative? delay)))
(raise-type-error 'call-with-file-lock/timeout "non-negative real" delay))
(unless (and (real? max-delay) (not (negative? max-delay)))
(raise-type-error 'call-with-file-lock/timeout "non-negative real" max-delay))
(define real-get-lock-file
(define real-lock-file
(if (procedure? get-lock-file) (get-lock-file) get-lock-file))
(call-with-file-lock
kind
real-get-lock-file
thunk
(lambda ()
(if (delay . < . max-delay)
(begin
(sleep delay)
(call-with-file-lock/timeout fn kind thunk failure-thunk #:delay (* 2 delay)
#:get-lock-file real-get-lock-file
#:max-delay max-delay))
(failure-thunk)))))
(unless (path-string? real-lock-file)
(raise-type-error 'call-with-file-lock/timeout "procedure (arity 0) returning a path-string? or path-string?" get-lock-file))
(let loop ([delay delay])
(call-with-file-lock
kind
real-lock-file
thunk
(lambda ()
(if (delay . < . max-delay)
(begin
(sleep delay)
(loop (* 2 delay)))
(failure-thunk))))))
(define (call-with-preference-file-lock who kind get-lock-file thunk lock-there)
(define lock-style (preferences-lock-file-mode))

6
collects/scribblings/reference/filesystem.scrbl
View File

@ -1056,9 +1056,9 @@ with the given @racket[lock-there], instead.}
[kind (or/c 'shared 'exclusive)]
[thunk (-> any)]
[failure-thunk (-> any)]
[#:get-lock-file get-lock-file (-> path-string?) (lambda () (make-lock-filename filename))]
[#:delay delay real? 0.01]
[#:max-delay max-delay real? 0.2])
[#:get-lock-file get-lock-file (or/c path-string? (-> path-string?)) (make-lock-filename filename)]
[#:delay delay (and/c real? (not/c negative?)) 0.01]
[#:max-delay max-delay (and/c real? (not/c negative?)) 0.2])
any]{
Obtains a lock for the filename returned from @racket[(get-lock-file)] and then