@@ -1398,14 +1398,18 @@ (define fcntl-flock
;; Presumably we got EAGAIN or so.
(throw 'flock-error err))))))
-(define* (lock-file file #:key (wait? #t))
- "Wait and acquire an exclusive lock on FILE. Return an open port."
- (let ((port (open-file file "w0")))
- (fcntl-flock port 'write-lock #:wait? wait?)
+(define* (lock-file file #:optional (mode "w0")
+ #:key (wait? #t))
+ "Wait and acquire an exclusive lock on FILE. Return an open port according
+to MODE."
+ (let ((port (open-file file mode)))
+ (fcntl-flock port
+ (if (output-port? port) 'write-lock 'read-lock)
+ #:wait? wait?)
port))
(define (unlock-file port)
- "Unlock PORT, a port returned by 'lock-file'."
+ "Unlock PORT, a port returned by 'lock-file', and close it."
(fcntl-flock port 'unlock)
(close-port port)
#t)
@@ -383,6 +383,19 @@ (define perform-container-tests?
(close-port file)
result)))))))))
+(test-equal "lock-file + unlock-file"
+ 'hello
+ (call-with-temporary-directory
+ (lambda (directory)
+ (let* ((file (in-vicinity directory "lock"))
+ (out (lock-file file #:wait? #f)))
+ (display "hello" out)
+ (unlock-file out)
+ (let* ((in (lock-file file "r0"))
+ (content (read in)))
+ (unlock-file in)
+ content)))))
+
(test-equal "set-thread-name"
"Syscall Test"
(let ((name (thread-name)))