ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

syscalls: Add ‘mode’ parameter to ‘lock-file’.

Browse source 
* guix/build/syscalls.scm (lock-file): Add ‘mode’ parameter and honor it.
* tests/syscalls.scm ("lock-file + unlock-file"): New test.

Change-Id: I113fb4a8b35dd8782b9c0991574e39a4b4393333
This commit is contained in:
Ludovic Courtès 2024-07-16 11:01:57 +02:00
parent b87b96b9c7
commit 96cd163c14
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 22 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
guix/build/syscalls.scm
View file

@ -1398,14 +1398,18 @@ (define bv
;; Presumably we got EAGAIN or so. ;; Presumably we got EAGAIN or so.
(throw 'flock-error err)))))) (throw 'flock-error err))))))
(define* (lock-file file #:key (wait? #t)) (define* (lock-file file #:optional (mode "w0")
"Wait and acquire an exclusive lock on FILE. Return an open port." #:key (wait? #t))
(let ((port (open-file file "w0"))) "Wait and acquire an exclusive lock on FILE. Return an open port according
(fcntl-flock port 'write-lock #:wait? wait?) to MODE."
(let ((port (open-file file mode)))
(fcntl-flock port
(if (output-port? port) 'write-lock 'read-lock)
#:wait? wait?)
port)) port))
(define (unlock-file 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) (fcntl-flock port 'unlock)
(close-port port) (close-port port)
#t) #t)

13
tests/syscalls.scm
View file

@ -383,6 +383,19 @@ (define perform-container-tests?
(close-port file) (close-port file)
result))))))))) 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" (test-equal "set-thread-name"
"Syscall Test" "Syscall Test"
(let ((name (thread-name))) (let ((name (thread-name)))