test/test-roster.sgl

1(import (sigil test)

2 (sigil xmpp roster)

3 (sigil xmpp stanza))

5;; ============================================================

6;; Roster Parsing

7;; ============================================================

9(test-group "roster-parsing"

10 (test "parse roster query"

11 (let ((items (parse-roster-query

12 '(query (@ (xmlns "jabber:iq:roster"))

13 (item (@ (jid "[email protected]")

14 (name "Alice")

15 (subscription "both"))

16 (group "Friends"))

17 (item (@ (jid "[email protected]")

18 (subscription "from")))))))

19 (assert-equal 2 (length items))

21 (let ((alice (car items)))

22 (assert-equal "[email protected]" (roster-item-jid alice))

23 (assert-equal "Alice" (roster-item-name alice))

24 (assert-equal "both" (roster-item-subscription alice))

25 (assert-equal '("Friends") (roster-item-groups alice)))

27 (let ((bob (cadr items)))

28 (assert-equal "[email protected]" (roster-item-jid bob))

29 (assert-false (roster-item-name bob))

30 (assert-equal "from" (roster-item-subscription bob))

31 (assert-equal '() (roster-item-groups bob)))))

33 (test "parse empty roster"

34 (let ((items (parse-roster-query

35 '(query (@ (xmlns "jabber:iq:roster"))))))

36 (assert-equal '() items)))

38 (test "parse roster item with multiple groups"

39 (let ((items (parse-roster-query

40 '(query (@ (xmlns "jabber:iq:roster"))

41 (item (@ (jid "a@b") (subscription "both"))

42 (group "Work")

43 (group "Friends"))))))

44 (assert-equal '("Work" "Friends")

45 (roster-item-groups (car items))))))

47;; ============================================================

48;; Subscription Stanza Construction

49;; ============================================================

51(test-group "subscription"

52 (test "subscribe presence type"

53 (let ((p (xmpp-presence to: "[email protected]" type: "subscribe")))

54 (assert-equal "subscribe" (stanza-attr p 'type))

55 (assert-equal "[email protected]" (stanza-to p)))))

57(run-tests)