on 448bfaf help sign in
56 lines 1.7 kB history raw
1#lang racket
3(require "main.rkt" rackunit)
5;; Helper for test cases with multiple outputs
6;; See: https://stackoverflow.com/questions/41081395/unit-testing-in-racket-with-multiple-outputs
7(define-syntax check-values-equal?
8 (syntax-rules ()
9 [(_ a b) (check-equal? (call-with-values (thunk a) list) b)]))
12;; Named POSIX semaphores
13(test-begin
14 (define test-sem-name "/test-nix-1")
16 ;; Unlink if already exists
17 (sem-unlink test-sem-name)
19 ;; Open and unlink
20 (define test-sem-p (sem-open test-sem-name (+ O_CREAT O_EXCL)))
21 (check-not-false test-sem-p)
22 (check-not-equal? test-sem-p (void))
23 (check-exn exn:fail?
24 (lambda () (sem-open test-sem-name (+ O_CREAT O_EXCL)))
25 "Permission denied")
26 (check-exn exn:fail?
27 (lambda () (sem-open test-sem-name (+ O_CREAT O_EXCL))))
29 ;; Change values
30 (check-equal? (sem-getvalue test-sem-p) 0)
31 (sem-post test-sem-p)
32 (check-equal? (sem-getvalue test-sem-p) 1)
33 (sem-wait test-sem-p)
34 (check-equal? (sem-getvalue test-sem-p) 0)
35 (sem-post test-sem-p)
36 (check-equal? (sem-getvalue test-sem-p) 1)
37 (sem-post test-sem-p)
38 (check-equal? (sem-getvalue test-sem-p) 2)
39 (sem-trywait test-sem-p)
40 (check-equal? (sem-getvalue test-sem-p) 2)
42 ;; Can't unlink twice
43 (check-not-false (sem-unlink test-sem-name))
44 (check-false (sem-unlink test-sem-name)))
47;; Named POSIX shared memory
48(test-begin
49 (define test-shm-name "test-nix-mem-1")
51 ;; Open and unlink
52 (shm-unlink test-shm-name)
53 (define test-shm-fd (shm-open test-shm-name (+ O_EXCL O_CREAT O_RDWR) #o644))
54 (check > test-shm-fd 0)
55 (check-not-false (shm-unlink test-shm-name))
56 (check-false (shm-unlink test-shm-name)))