test (and fix) run-handler-loop
[software/gnubba.git] / spec / xmpp.scm
1 (use-modules (gnubba xmpp))
2
3 (suite "iq/message/presence stanzas"
4 (tests
5 (test "iq should return a simple iq stanza" e
6 (assert-equal '(*TOP* (iq (@ (to "romeo@capulet.it")
7 (type "get")
8 (id "1234"))
9 "payload"))
10 (e 'iq1)))
11 (test "message should return a simple message stanza" e
12 (assert-equal '(*TOP* (message (@ (to "romeo@capulet.it"))
13 (body "hello, romeo!")))
14 (e 'message1)))
15 (test "presence should return a simple presence stanza" e
16 (assert-equal '(*TOP* (presence (@ (id "1234"))))
17 (e 'presence1)))
18 (test "presence takes optional body argument" e
19 (assert-equal '(*TOP* (presence (@ (id "1234")) "body"))
20 (e 'presence2)))
21 (test "iq? should return #t on an iq stanza" e
22 (assert-true (iq? (e 'iq1))))
23 (test "iq? should return #f on any other stanza" e
24 (assert-false (iq? (e 'message1))))
25 (test "message? should return #t on a message stanza" e
26 (assert-true (message? (e 'message1))))
27 (test "message? should return #f on any other stanza" e
28 (assert-false (message? (e 'iq1))))
29 (test "presence? should return #t on a presence stanza" e
30 (assert-true (presence? (e 'presence1))))
31 (test "presence? should return #f on any other stanza" e
32 (assert-false (presence? (e 'iq1)))))
33 (options)
34 (setups
35 (setup 'iq1 (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
36 (setup 'message1 (message "romeo@capulet.it" "hello, romeo!"))
37 (setup 'presence1 (presence #:id "1234"))
38 (setup 'presence2 (presence "body" #:id "1234"))
39 (setup 'presence3 (presence "body" #:id "1234" #:from "romeo@capulet.it"))))
40
41
42 (suite "register-stanza-handler"
43 (tests
44 (test "initially, *stanza-handlers* should be empty" e
45 (assert-equal '() ((e 'handlers))))
46 (test "after registering a handler *stanza-handlers* contains one handler" e
47 (assert-equal 1
48 (begin
49 (register-stanza-handler (lambda _ 'handler1))
50 (length ((e 'handlers))))))
51 (test "after registering two handlers *stanza-handlers* contains two handlers" e
52 (assert-equal 2
53 (begin
54 (register-stanza-handler (lambda _ 'handler1))
55 (register-stanza-handler (lambda _ 'handler2))
56 (length ((e 'handlers))))))
57 (test "handlers may have guards" e
58 (assert-equal 3
59 (begin
60 (register-stanza-handler message?
61 (lambda _ 'handler1))
62 (register-stanza-handler iq?
63 (lambda _ 'handler2))
64 (register-stanza-handler #t
65 (lambda _ 'handler2))
66 (length ((e 'handlers)))))))
67 (options)
68 (setups
69 (setup 'handlers (lambda () (@@ (gnubba xmpp) *stanza-handlers*))))
70 (teardowns
71 ;; always reset the internal state after each test
72 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
73
74
75 (suite "try-stanza-handlers"
76 (tests
77 (test "a handler registered without a guard or #t is executed for any stanza" e
78 (assert-equal '(handler2 handler1)
79 (begin
80 (register-stanza-handler
81 (lambda _ 'handler1))
82 (register-stanza-handler
83 #t
84 (lambda _ 'handler2))
85 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
86 (test "handlers with guards are only executed for stanzas that match (a)" e
87 (assert-equal '(#f handler1)
88 (begin
89 (register-stanza-handler message?
90 (lambda _ 'handler1))
91 (register-stanza-handler iq?
92 (lambda _ 'handler2))
93 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
94 (test "handlers with guards are only executed for stanzas that match (b)" e
95 (assert-equal '(handler2 #f)
96 (begin
97 (register-stanza-handler message?
98 (lambda _ 'handler1))
99 (register-stanza-handler iq?
100 (lambda _ 'handler2))
101 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'iq1)))))
102 (test "no handlers are executed if none of the guards match the stanza" e
103 (assert-equal '(#f #f)
104 (begin
105 (register-stanza-handler message?
106 (lambda _ 'handler1))
107 (register-stanza-handler iq?
108 (lambda _ 'handler2))
109 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'presence1)))))
110 (test "when a handler throws 'halt no other handlers are executed" e
111 (assert-equal '(handler2 handler3)
112 (let ((*executed* '()))
113 (register-stanza-handler
114 (lambda _ (set! *executed* (cons 'handler1 *executed*))))
115 (register-stanza-handler
116 (lambda _
117 (set! *executed* (cons 'handler2 *executed*))
118 (throw 'halt 'handler2)))
119 (register-stanza-handler
120 (lambda _ (set! *executed* (cons 'handler3 *executed*))))
121 (catch 'halt
122 (lambda _
123 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))
124 (lambda _ #t))
125 *executed*))))
126 (options)
127 (setups
128 (setup 'iq1 (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
129 (setup 'message1 (message "romeo@capulet.it" "hello, romeo!"))
130 (setup 'presence1 (presence #:id "1234")))
131 (teardowns
132 ;; always reset the internal state after each test
133 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
134
135 ;; TODO
136 (suite "next-stanza-id!" (tests))
137 (suite "handle-stanza" (tests))
138 (suite "register-temp-stanza-handler-for-id" (tests))
139 (suite "register-stanza-handler" (tests))
140
141 (suite "run-handler-loop"
142 (tests
143 (test "does not die when a handler throws an exception" e
144 (assert-false
145 (error? (begin
146 (register-stanza-handler
147 (lambda _ (throw 'some-error "no reason")))
148 (call-with-input-string
149 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
150 run-handler-loop)))))
151 (test "processes all stanzas in the queue" e
152 (assert-equal 2
153 (let ((count 0))
154 (register-stanza-handler
155 (lambda _ (begin (set! count (1+ count))
156 (throw 'some-error "no reason"))))
157 (call-with-input-string
158 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
159 run-handler-loop)
160 count)))))