diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/utils.scm | 32 |
1 files changed, 31 insertions, 1 deletions
diff --git a/tests/utils.scm b/tests/utils.scm index 017d9170fa..b5706aa792 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -139,6 +139,36 @@ (append pids1 pids2))) (equal? (get-bytevector-all decompressed) data))))) +(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) + (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))) + (primitive-exit 1)) + (lambda () + (primitive-exit 2)))) + (pid + (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" |