source: project/release/5/zmq/trunk/tests/run.scm @ 37648

Last change on this file since 37648 was 37648, checked in by Ivan Raikov, 18 months ago

C5 port of zmq

File size: 3.6 KB
Line 
1(import scheme (chicken base) (chicken format) (chicken memory) (chicken blob)
2        zmq  test  srfi-1 srfi-18 srfi-4)
3
4(test-group "contexts"
5  (test-assert (context? (make-context 1)))
6  (test-error (make-context -1)))
7
8(define make-bound-socket-pair
9  (let ((count 0))
10    (lambda (server client)
11      (let ((s (make-socket server))
12            (c (make-socket client))
13            (e (sprintf "inproc://test~A" count)))
14        (bind-socket s e)
15        (connect-socket c e)
16        (set! count (add1 count))
17        (values s c)))))
18
19(test-group "sockets"
20
21  (test-group "default-context"
22    (test-assert (not (zmq-default-context)))
23    (make-socket 'rep)
24    (test-assert (context? (zmq-default-context))))
25
26  (test-group "options"
27    (let ((s (make-socket 'pull)))
28      (test 1000 (socket-option s 'rcvhwm))
29      (socket-option-set! s 'rcvhwm 2000)
30      (test 2000 (socket-option s 'rcvhwm))
31      (socket-option-set! s 'identity "nomnom")
32      (test "nomnom" (socket-option s 'identity))
33      (test-assert (number? (socket-fd s)))))
34
35  (test-group "push/pull"
36    (receive (push pull) 
37             (make-bound-socket-pair 'push 'pull)
38      (send-message push "hey")
39      (test "hey" (receive-message pull))
40      (send-message push "ho")
41      (test "ho" (receive-message pull))
42      (test-error (receive-message push))
43      (test-error (send-message pull "impossible"))))
44
45  (test-group "pub/sub"
46    (receive (pub sub)
47        (make-bound-socket-pair 'pub 'sub)
48      (socket-option-set! sub 'subscribe "foo")
49      (send-message pub "foo bar!")
50      (test "foo bar!" (receive-message sub))
51      (send-message pub "bar!")
52      (test-assert (not (receive-message sub non-blocking: #t)))))
53
54  (test-group "rep/req"
55    (receive (rep req)
56        (make-bound-socket-pair 'rep 'req)
57      (send-message req "foo")
58      (test "foo" (receive-message rep))
59      (send-message rep "bar")
60      (test "bar" (receive-message req))
61      (test-error (receive-message req))
62      (test-error (send-message rep "nope"))))
63
64  (test-group "non-blocking read"
65    (receive (a b)
66        (make-bound-socket-pair 'push 'pull)
67      (test-assert (not (receive-message b non-blocking: #t)))
68      (send-message a "foo bar!")
69      (test "foo bar!" (receive-message b non-blocking: #t))))
70
71  ;; this is to test the context finalizer; if it doesn't work, a
72  ;; double-free error will be raised after the tests have finished
73  (define some-socket (make-socket 'push))
74  (close-socket some-socket))
75
76(test-group "polling"
77  (receive (a b)
78      (make-bound-socket-pair 'push 'pull)
79
80    (let* ((c (make-socket 'pull))
81           (d (make-socket 'pull))
82           (pis (map (cut make-poll-item <> in: #t) (list b c d))))
83
84      (test 0 (poll pis #f))
85      (send-message a "check")
86      (test 1 (poll pis #t))
87      (test 1 (length (filter poll-item-in? pis))))))
88
89(test-group "messages"
90  (receive (a b)
91      (make-bound-socket-pair 'push 'pull)
92
93    (send-message a "hey")
94
95    (let ((c (receive-message b as: cons)))
96      (test-assert (pointer? (car c)))
97      (test 3 (cdr c)))
98
99    (send-message a "ho")
100    (test (string->blob "ho") (receive-message b as: 'blob))
101
102    (send-message a (u8vector->blob (u8vector 102 111 111)))
103    (test "foo" (receive-message b))))
104
105(test-group "receiving messages blockingly without blocking the whole process"
106  (receive (a b)
107      (make-bound-socket-pair 'push 'pull)
108
109    (thread-start! 
110     (lambda ()
111       (test "yes" (receive-message* b))))
112
113    ;; yes that is kind of silly but I have no better idea to test it
114    ;; -- patches welcome!
115    (thread-sleep! 0.5)
116    (send-message a "yes")
117    (thread-sleep! 0.5)))
118
119(test-exit)
Note: See TracBrowser for help on using the repository browser.