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

collects/racket/file.rkt

@@ -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)]
+                                     #:get-lock-file [get-lock-file (λ () (make-lock-file-name fn))]
-    #:delay [delay 0.01]
+                                     #:delay [delay 0.01]
-    #:max-delay [max-delay 0.2])
+                                     #: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))
+              (and (procedure? get-lock-file) (= (procedure-arity get-lock-file) 0)))
-    (raise-type-error 'call-with-file-lock/timeout "procedure (arity 0)" get-lock-file))
+    (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 
+  (unless (path-string? real-lock-file)
-    kind 
+    (raise-type-error 'call-with-file-lock/timeout "procedure (arity 0) returning a path-string? or path-string?" get-lock-file))
-    real-get-lock-file
+  (let loop ([delay delay])
-    thunk
+    (call-with-file-lock 
-    (lambda ()
+     kind 
-      (if (delay . < . max-delay)
+     real-lock-file
-        (begin
+     thunk
-          (sleep delay)
+     (lambda ()
-          (call-with-file-lock/timeout fn kind thunk failure-thunk #:delay (* 2 delay)
+       (if (delay . < . max-delay)
-            #:get-lock-file real-get-lock-file 
+           (begin
-            #:max-delay max-delay))
+             (sleep delay)
-      (failure-thunk)))))
+             (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))

collects/scribblings/reference/filesystem.scrbl

@@ -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))]
+          [#:get-lock-file get-lock-file (or/c path-string? (-> path-string?)) (make-lock-filename filename)]
-          [#:delay delay real? 0.01]
+          [#:delay delay (and/c real? (not/c negative?)) 0.01]
-          [#:max-delay max-delay real? 0.2])
+          [#: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