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

tests: Avoid buffering in 'fcntl-flock' tests.

Browse source 
Partially fixes <http://bugs.gnu.org/17212>.

* tests/utils.scm ("fcntl-flock wait", "fcntl-flock non-blocking"): Open
  files in binary mode, with no buffering.
This commit is contained in:
Ludovic Courtès 2014-04-07 18:08:56 +02:00
parent 1d000ae73b
commit 68ec0450d1
1 changed files with 5 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
tests/utils.scm
View file

@ -176,7 +176,7 @@ (define temp-file
(false-if-exception (delete-file temp-file))
(test-equal "fcntl-flock wait"
42 ; the child's exit status
(let ((file (open-file temp-file "w0")))
(let ((file (open-file temp-file "w0b")))
;; Acquire an exclusive lock.
(fcntl-flock file 'write-lock)
(match (primitive-fork)
@ -185,7 +185,7 @@ (define temp-file
(const #t)
(lambda ()
;; Reopen FILE read-only so we can have a read lock.
(let ((file (open-file temp-file "r")))
(let ((file (open-file temp-file "r0b")))
;; Wait until we can acquire the lock.
(fcntl-flock file 'read-lock)
(primitive-exit (read file)))
@ -228,19 +228,19 @@ (define temp-file
(read-char input)
;; Open FILE read-only so we can have a read lock.
(let ((file (open-file temp-file "w")))
(let ((file (open-file temp-file "w0")))
(catch 'flock-error
(lambda ()
;; This attempt should throw EAGAIN.
(fcntl-flock file 'write-lock #:wait? #f))
(lambda (key errno)
(primitive-exit errno))))
(primitive-exit (pk 'errno errno)))))
(primitive-exit -1))
(lambda ()
(primitive-exit -2))))
(pid
(close-port input)
(let ((file (open-file temp-file "w")))
(let ((file (open-file temp-file "w0")))
;; Acquire an exclusive lock.
(fcntl-flock file 'write-lock)