From 96cd163c14e68c66c6a4cf0b18261fc454f8c1ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Tue, 16 Jul 2024 11:01:57 +0200 Subject: [PATCH] =?UTF-8?q?syscalls:=20Add=20=E2=80=98mode=E2=80=99=20para?= =?UTF-8?q?meter=20to=20=E2=80=98lock-file=E2=80=99.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/build/syscalls.scm (lock-file): Add ‘mode’ parameter and honor it. * tests/syscalls.scm ("lock-file + unlock-file"): New test. Change-Id: I113fb4a8b35dd8782b9c0991574e39a4b4393333 --- guix/build/syscalls.scm | 14 +++++++++----- tests/syscalls.scm | 13 +++++++++++++ 2 files changed, 22 insertions(+), 5 deletions(-) diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 39bcffd516..2c20edf058 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1398,14 +1398,18 @@ (define bv ;; 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) diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 7cf67c060d..13f4f11721 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -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)))