diff options
| -rw-r--r-- | tests/utils.scm | 43 |
1 files changed, 29 insertions, 14 deletions
diff --git a/tests/utils.scm b/tests/utils.scm index b5706aa792..5be7baf016 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -27,6 +27,9 @@ #:use-module (rnrs io ports) #:use-module (ice-9 match)) +(define temp-file + (string-append "t-utils-" (number->string (getpid)))) + (test-begin "utils") (test-assert "bytevector->base16-string->bytevector" @@ -139,33 +142,43 @@ (append pids1 pids2))) (equal? (get-bytevector-all decompressed) data))))) +(false-if-exception (delete-file temp-file)) (test-equal "fcntl-flock" - 0 ; the child's exit status - (let ((file (open-input-file (search-path %load-path "guix.scm")))) - (fcntl-flock file 'read-lock) + 42 ; the child's exit status + (let ((file (open-file temp-file "w0"))) + ;; Acquire an exclusive lock. + (fcntl-flock file 'write-lock) (match (primitive-fork) (0 (dynamic-wind (const #t) (lambda () - ;; Taking a read lock should be OK. - (fcntl-flock file 'read-lock) - (fcntl-flock file 'unlock) - - (catch 'flock-error - (lambda () - ;; Taking an exclusive lock should raise an exception. - (fcntl-flock file 'write-lock)) - (lambda args - (primitive-exit 0))) + ;; Reopen FILE read-only so we can have a read lock. + (let ((file (open-file temp-file "r"))) + ;; 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))) - (fcntl-flock file 'unlock) (close-port file) result))))))) @@ -178,5 +191,7 @@ (test-end) +(false-if-exception (delete-file temp-file)) + (exit (= (test-runner-fail-count (test-runner-current)) 0)) |