diff options
| -rw-r--r-- | spec/xmpp.scm | 140 |
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)) |