aboutsummaryrefslogtreecommitdiff
path: root/tests/utils.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-05-06 13:12:45 +0200
committerLudovic Courtès <ludo@gnu.org>2016-05-06 13:25:30 +0200
commit4e0ea3eb288c2143b44bf324c64047762c72d3b3 (patch)
treea261da4f5d972b0a90827347a3a987534ab80ac7 /tests/utils.scm
parentba2613bb4e47938044a3c96b92debf1bddcf0140 (diff)
downloadguix-4e0ea3eb288c2143b44bf324c64047762c72d3b3.tar
guix-4e0ea3eb288c2143b44bf324c64047762c72d3b3.tar.gz
utils: Move 'fcntl-flock' to (guix build syscalls).
* guix/utils.scm (%struct-flock, F_SETLKW, F_SETLK, F_xxLCK) (fcntl-flock): Move to... * guix/build/syscalls.scm: ... here. New variables. * guix/nar.scm: Adjust imports accordingly. * tests/utils.scm ("fcntl-flock wait", "fcntl-flock non-blocking"): Move to... * tests/syscalls.scm: ... here. New tests. (temp-file): New variable.
Diffstat (limited to 'tests/utils.scm')
-rw-r--r--tests/utils.scm82
1 files changed, 0 insertions, 82 deletions
diff --git a/tests/utils.scm b/tests/utils.scm
index a54482e94c..6590ed91cf 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -168,88 +168,6 @@
(call-with-decompressed-port 'xz (open-file temp-file "r0b")
get-bytevector-all))))
-(false-if-exception (delete-file temp-file))
-(test-equal "fcntl-flock wait"
- 42 ; the child's exit status
- (let ((file (open-file temp-file "w0b")))
- ;; Acquire an exclusive lock.
- (fcntl-flock file 'write-lock)
- (match (primitive-fork)
- (0
- (dynamic-wind
- (const #t)
- (lambda ()
- ;; Reopen FILE read-only so we can have a read lock.
- (let ((file (open-file temp-file "r0b")))
- ;; Wait until we can acquire the lock.
- (fcntl-flock file 'read-lock)
- (primitive-exit (read file)))
- (primitive-exit 1))
- (lambda ()
- (primitive-exit 2))))
- (pid
- ;; Write garbage and wait.
- (display "hello, world!" file)
- (force-output file)
- (sleep 1)
-
- ;; Write the real answer.
- (seek file 0 SEEK_SET)
- (truncate-file file 0)
- (write 42 file)
- (force-output file)
-
- ;; Unlock, which should let the child continue.
- (fcntl-flock file 'unlock)
-
- (match (waitpid pid)
- ((_ . status)
- (let ((result (status:exit-val status)))
- (close-port file)
- result)))))))
-
-(test-equal "fcntl-flock non-blocking"
- EAGAIN ; the child's exit status
- (match (pipe)
- ((input . output)
- (match (primitive-fork)
- (0
- (dynamic-wind
- (const #t)
- (lambda ()
- (close-port output)
-
- ;; Wait for the green light.
- (read-char input)
-
- ;; Open FILE read-only so we can have a read lock.
- (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 (pk 'errno errno)))))
- (primitive-exit -1))
- (lambda ()
- (primitive-exit -2))))
- (pid
- (close-port input)
- (let ((file (open-file temp-file "w0")))
- ;; Acquire an exclusive lock.
- (fcntl-flock file 'write-lock)
-
- ;; Tell the child to continue.
- (write 'green-light output)
- (force-output output)
-
- (match (waitpid pid)
- ((_ . status)
- (let ((result (status:exit-val status)))
- (fcntl-flock file 'unlock)
- (close-port file)
- result)))))))))
-
;; This is actually in (guix store).
(test-equal "store-path-package-name"
"bash-4.2-p24"