clean up the contract checking for call-with-file-lock/timeout
This commit is contained in:
parent
d12b617292
commit
78a999537d
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user