test/test-client.sgl — sigil-web-client

1(import (sigil test)

2 (sigil web client))

4(test-group "web-client-root?"

5 (test "accepts non-zero node handles"

6 (assert-true (web-client-root? 1))

7 (assert-true (web-client-root? 42)))

9 (test "rejects missing or invalid handles"

10 (assert-false (web-client-root? 0))

11 (assert-false (web-client-root? #f))

12 (assert-false (web-client-root? "1"))))

14(test-group "web-client-render"

15 (test "returns SXML values directly"

16 (assert-equal '(div "Hello") (web-client-render '(div "Hello"))))

18 (test "evaluates nullary view procedures"

19 (assert-equal '(span "Hi")

20 (web-client-render (lambda () '(span "Hi"))))))

22(test "web-client-memo construction is lazy"

23 (let ((called? #f))

24 (web-client-memo "turn-1" "complete"

25 (lambda () (set! called? #t) '(div "body")))

26 (assert-false called?)))

28(test-group "web-client-reset!"

29 (test "clears retained root state"

30 (assert-true (web-client-reset!))))

32;; Normalizing element content into a flat child list. The empty-content case

33;; is load-bearing: '() must stay '() so an emptied element reconciles as

34;; genuinely empty (old-records null => the empty->populated bulk clear fires).

35;; Before the null? case, '() fell to (else (list value)) => (()), a phantom

36;; empty text child that suppressed the clear and leaked foreign children.

37(test-group "web-client-normalize-children"

38 (test "empty content stays empty"

39 (assert-equal '() (web-client-normalize-children '())))

41 (test "#f content is empty"

42 (assert-equal '() (web-client-normalize-children #f)))

44 (test "a content list passes through unchanged"

45 (assert-equal '((span "a") (span "b"))

46 (web-client-normalize-children '((span "a") (span "b")))))

48 (test "a single atom is wrapped as one child"

49 (assert-equal '("hello") (web-client-normalize-children "hello"))))

51(test-group "web-client-memo-unchanged?"

52 (test "same key and revision retain a memoized subtree"

53 (assert-true

54 (web-client-memo-unchanged?

55 '((key "turn-1") (memo 4) (class "old"))

56 '((key "turn-1") (memo 4) (class "new")))))

58 (test "a changed revision invalidates the boundary"

59 (assert-false

60 (web-client-memo-unchanged?

61 '((key "turn-1") (memo 4))

62 '((key "turn-1") (memo 5)))))

64 (test "a changed key cannot inherit a memoized subtree"

65 (assert-false

66 (web-client-memo-unchanged?

67 '((key "turn-1") (memo 4))

68 '((key "turn-2") (memo 4)))))

70 (test "memo metadata without a key is never a boundary"

71 (assert-false

72 (web-client-memo-unchanged? '((memo 4)) '((memo 4))))))

74;; The pure child-order diff behind the keyed reconciler. Node handles are

75;; plain integers here, exactly as the DOM bridge represents them. Each op is

76;; (node . ref): insert node before ref, ref #f = append at the end.

77(test-group "web-client-child-moves"

78 (test "unchanged order produces zero operations"

79 (assert-equal '() (web-client-child-moves '(1 2 3) '(1 2 3)))

80 (assert-equal '() (web-client-child-moves '(7) '(7)))

81 (assert-equal '() (web-client-child-moves '() '())))

83 (test "initial population appends every node in order"

84 (assert-equal '((1 . #f) (2 . #f) (3 . #f))

85 (web-client-child-moves '() '(1 2 3))))

87 (test "appending at the end appends only the new nodes"

88 (assert-equal '((3 . #f) (4 . #f))

89 (web-client-child-moves '(1 2) '(1 2 3 4))))

91 (test "inserting in the middle inserts before the displaced node"

92 (assert-equal '((2 . 3))

93 (web-client-child-moves '(1 3) '(1 2 3))))

95 (test "inserting at the front inserts before the old head"

96 (assert-equal '((9 . 1))

97 (web-client-child-moves '(1 2) '(9 1 2))))

99 (test "moving the last node to the front is a single move"

100 (assert-equal '((3 . 1))

101 (web-client-child-moves '(1 2 3) '(3 1 2))))

102

103 (test "swapping adjacent nodes is a single move"

104 (assert-equal '((3 . 2))

105 (web-client-child-moves '(1 2 3) '(1 3 2))))

106

107 (test "reversal moves all but the anchor node"

108 (assert-equal '((3 . 1) (2 . 1))

109 (web-client-child-moves '(1 2 3) '(3 2 1))))

110

111 (test "removal alone needs no moves (dropped nodes are pruned first)"

112 ;; patch-children removes dropped nodes before diffing, so current

113 ;; arrives already pruned: '(1 3) against target '(1 3).

114 (assert-equal '() (web-client-child-moves '(1 3) '(1 3))))

115

116 (test "mixed insert + reorder + append"

117 ;; current [1 2 3] -> target [2 9 1 3 4]

118 ;; 2 moves to front; 9 is new before 1; 3 already after 1; 4 appended.

119 (assert-equal '((2 . 1) (9 . 1) (4 . #f))

120 (web-client-child-moves '(1 2 3) '(2 9 1 3 4)))))