diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/utils.scm | 44 |
1 files changed, 43 insertions, 1 deletions
diff --git a/tests/utils.scm b/tests/utils.scm index 5be7baf016..adac5d4381 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -143,7 +143,7 @@ (equal? (get-bytevector-all decompressed) data))))) (false-if-exception (delete-file temp-file)) -(test-equal "fcntl-flock" +(test-equal "fcntl-flock wait" 42 ; the child's exit status (let ((file (open-file temp-file "w0"))) ;; Acquire an exclusive lock. @@ -182,6 +182,48 @@ (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 "w"))) + (catch 'flock-error + (lambda () + ;; This attempt should throw EAGAIN. + (fcntl-flock file 'write-lock #:wait? #f)) + (lambda (key errno) + (primitive-exit errno)))) + (primitive-exit -1)) + (lambda () + (primitive-exit -2)))) + (pid + (close-port input) + (let ((file (open-file temp-file "w"))) + ;; 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" |