move and remove test placeholders
[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 ;; TODO
42 (suite "register-temp-stanza-handler-for-id" (tests))
43
44 (suite "register-stanza-handler"
45 (tests
46 (test "initially, *stanza-handlers* should be empty" e
47 (assert-equal '() ((e 'handlers))))
48 (test "after registering a handler *stanza-handlers* contains one handler" e
49 (assert-equal 1
50 (begin
51 (register-stanza-handler (lambda _ 'handler1))
52 (length ((e 'handlers))))))
53 (test "after registering two handlers *stanza-handlers* contains two handlers" e
54 (assert-equal 2
55 (begin
56 (register-stanza-handler (lambda _ 'handler1))
57 (register-stanza-handler (lambda _ 'handler2))
58 (length ((e 'handlers))))))
59 (test "handlers may have guards" e
60 (assert-equal 3
61 (begin
62 (register-stanza-handler message?
63 (lambda _ 'handler1))
64 (register-stanza-handler iq?
65 (lambda _ 'handler2))
66 (register-stanza-handler #t
67 (lambda _ 'handler2))
68 (length ((e 'handlers)))))))
69 (options)
70 (setups
71 (setup 'handlers (lambda () (@@ (gnubba xmpp) *stanza-handlers*))))
72 (teardowns
73 ;; always reset the internal state after each test
74 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
75
76 (suite "try-stanza-handlers"
77 (tests
78 (test "a handler registered without a guard or #t is executed for any stanza" e
79 (assert-equal '(handler2 handler1)
80 (begin
81 (register-stanza-handler
82 (lambda _ 'handler1))
83 (register-stanza-handler
84 #t
85 (lambda _ 'handler2))
86 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
87 (test "handlers with guards are only executed for stanzas that match (a)" e
88 (assert-equal '(#f handler1)
89 (begin
90 (register-stanza-handler message?
91 (lambda _ 'handler1))
92 (register-stanza-handler iq?
93 (lambda _ 'handler2))
94 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
95 (test "handlers with guards are only executed for stanzas that match (b)" e
96 (assert-equal '(handler2 #f)
97 (begin
98 (register-stanza-handler message?
99 (lambda _ 'handler1))
100 (register-stanza-handler iq?
101 (lambda _ 'handler2))
102 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'iq1)))))
103 (test "no handlers are executed if none of the guards match the stanza" e
104 (assert-equal '(#f #f)
105 (begin
106 (register-stanza-handler message?
107 (lambda _ 'handler1))
108 (register-stanza-handler iq?
109 (lambda _ 'handler2))
110 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'presence1)))))
111 (test "when a handler throws 'halt no other handlers are executed" e
112 (assert-equal '(handler2 handler3)
113 (let ((*executed* '()))
114 (register-stanza-handler
115 (lambda _ (set! *executed* (cons 'handler1 *executed*))))
116 (register-stanza-handler
117 (lambda _
118 (set! *executed* (cons 'handler2 *executed*))
119 (throw 'halt 'handler2)))
120 (register-stanza-handler
121 (lambda _ (set! *executed* (cons 'handler3 *executed*))))
122 (catch 'halt
123 (lambda _
124 ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))
125 (lambda _ #t))
126 *executed*))))
127 (options)
128 (setups
129 (setup 'iq1 (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
130 (setup 'message1 (message "romeo@capulet.it" "hello, romeo!"))
131 (setup 'presence1 (presence #:id "1234")))
132 (teardowns
133 ;; always reset the internal state after each test
134 (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
135
136 ;; TODO
137 (suite "next-stanza-id!" (tests))
138 (suite "handle-stanza" (tests))
139
140 (suite "run-handler-loop"
141 (tests
142 (test "does not die when a handler throws an exception" e
143 (assert-false
144 (error? (begin
145 (register-stanza-handler
146 (lambda _ (throw 'some-error "no reason")))
147 (call-with-input-string
148 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
149 run-handler-loop)))))
150 (test "processes all stanzas in the queue" e
151 (assert-equal 2
152 (let ((count 0))
153 (register-stanza-handler
154 (lambda _ (begin (set! count (1+ count))
155 (throw 'some-error "no reason"))))
156 (call-with-input-string
157 "<iq from='test' id='123'/><iq from='someone' id='234'/>"
158 run-handler-loop)
159 count)))))