add test suite

depends on ggspec (https://github.com/yawaramin/ggspec)

1 files changed, 140 insertions, 0 deletions

diff --git a/spec/xmpp.scm b/spec/xmpp.scm
new file mode 100644
index 0000000..cf61e7c
--- /dev/null
+++ b/spec/xmpp.scm
@@ -0,0 +1,140 @@
+(use-modules (gnubba xmpp))
+
+(suite "iq/message/presence stanzas"
+       (tests
+        (test "iq should return a simple iq stanza" e
+              (assert-equal '(*TOP* (iq (@ (to "romeo@capulet.it")
+                                           (type "get")
+                                           (id "1234"))
+                                        "payload"))
+                            (e 'iq1)))
+        (test "message should return a simple message stanza" e
+              (assert-equal '(*TOP* (message (@ (to "romeo@capulet.it"))
+                                             (body "hello, romeo!")))
+                            (e 'message1)))
+        (test "presence should return a simple presence stanza" e
+              (assert-equal '(*TOP* (presence (@ (id "1234"))))
+                            (e 'presence1)))
+        (test "presence takes optional body argument" e
+              (assert-equal '(*TOP* (presence (@ (id "1234")) "body"))
+                            (e 'presence2)))
+        (test "iq? should return #t on an iq stanza" e
+              (assert-true (iq? (e 'iq1))))
+        (test "iq? should return #f on any other stanza" e
+              (assert-false (iq? (e 'message1))))
+        (test "message? should return #t on a message stanza" e
+              (assert-true (message? (e 'message1))))
+        (test "message? should return #f on any other stanza" e
+              (assert-false (message? (e 'iq1))))
+        (test "presence? should return #t on a presence stanza" e
+              (assert-true (presence? (e 'presence1))))
+        (test "presence? should return #f on any other stanza" e
+              (assert-false (presence? (e 'iq1)))))
+       (options)
+       (setups
+        (setup 'iq1       (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
+        (setup 'message1  (message "romeo@capulet.it" "hello, romeo!"))
+        (setup 'presence1 (presence #:id "1234"))
+        (setup 'presence2 (presence "body" #:id "1234"))
+        (setup 'presence3 (presence "body" #:id "1234" #:from "romeo@capulet.it"))))
+
+
+(suite "register-stanza-handler"
+       (tests
+        (test "initially, *stanza-handlers* should be empty" e
+              (assert-equal '() ((e 'handlers))))
+        (test "after registering a handler *stanza-handlers* contains one handler" e
+              (assert-equal 1
+                            (begin
+                              (register-stanza-handler (lambda _ 'handler1))
+                              (length ((e 'handlers))))))
+        (test "after registering two handlers *stanza-handlers* contains two handlers" e
+              (assert-equal 2
+                            (begin
+                              (register-stanza-handler (lambda _ 'handler1))
+                              (register-stanza-handler (lambda _ 'handler2))
+                              (length ((e 'handlers))))))
+        (test "handlers may have guards" e
+              (assert-equal 3
+                            (begin
+                              (register-stanza-handler message?
+                                                       (lambda _ 'handler1))
+                              (register-stanza-handler iq?
+                                                       (lambda _ 'handler2))
+                              (register-stanza-handler #t
+                                                       (lambda _ 'handler2))
+                              (length ((e 'handlers)))))))
+       (options)
+       (setups
+        (setup 'handlers  (lambda () (@@ (gnubba xmpp) *stanza-handlers*))))
+       (teardowns
+        ;; always reset the internal state after each test
+        (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
+
+
+(suite "try-stanza-handlers"
+       (tests
+        (test "a handler registered without a guard or #t is executed for any stanza" e
+              (assert-equal '(handler2 handler1)
+                            (begin
+                              (register-stanza-handler
+                               (lambda _ 'handler1))
+                              (register-stanza-handler
+                               #t
+                               (lambda _ 'handler2))
+                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
+        (test "handlers with guards are only executed for stanzas that match (a)" e
+              (assert-equal '(#f handler1)
+                            (begin
+                              (register-stanza-handler message?
+                                                       (lambda _ 'handler1))
+                              (register-stanza-handler iq?
+                                                       (lambda _ 'handler2))
+                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))))
+        (test "handlers with guards are only executed for stanzas that match (b)" e
+              (assert-equal '(handler2 #f)
+                            (begin
+                              (register-stanza-handler message?
+                                                       (lambda _ 'handler1))
+                              (register-stanza-handler iq?
+                                                       (lambda _ 'handler2))
+                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'iq1)))))
+        (test "no handlers are executed if none of the guards match the stanza" e
+              (assert-equal '(#f #f)
+                            (begin
+                              (register-stanza-handler message?
+                                                       (lambda _ 'handler1))
+                              (register-stanza-handler iq?
+                                                       (lambda _ 'handler2))
+                              ((@@ (gnubba xmpp) try-stanza-handlers) (e 'presence1)))))
+        (test "when a handler throws 'halt no other handlers are executed" e
+              (assert-equal '(handler2 handler3)
+                            (let ((*executed* '()))
+                              (register-stanza-handler
+                               (lambda _ (set! *executed* (cons 'handler1 *executed*))))
+                              (register-stanza-handler
+                               (lambda _
+                                 (set! *executed* (cons 'handler2 *executed*))
+                                 (throw 'halt 'handler2)))
+                              (register-stanza-handler
+                               (lambda _ (set! *executed* (cons 'handler3 *executed*))))
+                              (catch 'halt
+                                (lambda _
+                                  ((@@ (gnubba xmpp) try-stanza-handlers) (e 'message1)))
+                                (lambda _ #t))
+                              *executed*))))
+       (options)
+       (setups
+        (setup 'iq1       (iq "payload" #:to "romeo@capulet.it" #:id "1234"))
+        (setup 'message1  (message "romeo@capulet.it" "hello, romeo!"))
+        (setup 'presence1 (presence #:id "1234")))
+       (teardowns
+        ;; always reset the internal state after each test
+        (teardown e (set! (@@ (gnubba xmpp) *stanza-handlers*) '()))))
+
+;; TODO
+(suite "next-stanza-id!" (tests))
+(suite "handle-stanza" (tests))
+(suite "register-temp-stanza-handler-for-id" (tests))
+(suite "register-stanza-handler" (tests))
+(suite "run-handler-loop" (tests))