test/test-grid.sgl — sigil-tui

1(import (sigil test)

2 (sigil tui grid))

4;; Skip grid tests when native code isn't linked (make-grid will be #f)

5(when (not (procedure? make-grid))

6 (display "Skipping grid tests (native code not linked)\n")

7 (exit 0))

9(test-group "grid"

11 (test-group "creation"

12 (test "make-grid dimensions"

13 (let ((g (make-grid 80 24)))

14 (assert-equal 80 (grid-width g))

15 (assert-equal 24 (grid-height g))))

17 (test "default cells are spaces"

18 (let ((g (make-grid 10 5)))

19 (assert-equal #\space (cell-char (grid-ref g 0 0)))

20 (assert-equal -1 (cell-fg (grid-ref g 0 0)))

21 (assert-equal -1 (cell-bg (grid-ref g 0 0)))

22 (assert-equal 0 (cell-attrs (grid-ref g 0 0))))))

24 (test-group "cell operations"

25 (test "make-cell and accessors"

26 (let ((c (make-cell #\X color-red color-blue attr-bold)))

27 (assert-equal #\X (cell-char c))

28 (assert-equal color-red (cell-fg c))

29 (assert-equal color-blue (cell-bg c))

30 (assert-equal attr-bold (cell-attrs c))))

32 (test "cell equality"

33 (let ((a (make-cell #\A color-red color-default attr-none))

34 (b (make-cell #\A color-red color-default attr-none))

35 (c (make-cell #\B color-red color-default attr-none)))

36 (assert-true (cell=? a b))

37 (assert-false (cell=? a c)))))

39 (test-group "read/write"

40 (test "grid-set! and grid-ref"

41 (let ((g (make-grid 10 5)))

42 (grid-set! g 3 2 #\X color-green color-default attr-bold)

43 (assert-equal #\X (cell-char (grid-ref g 3 2)))

44 (assert-equal color-green (cell-fg (grid-ref g 3 2)))))

46 (test "grid-write-string!"

47 (let ((g (make-grid 10 5)))

48 (grid-write-string! g 2 1 "Hello" color-cyan color-default attr-none)

49 (assert-equal #\H (cell-char (grid-ref g 2 1)))

50 (assert-equal #\e (cell-char (grid-ref g 3 1)))

51 (assert-equal #\l (cell-char (grid-ref g 4 1)))

52 (assert-equal #\l (cell-char (grid-ref g 5 1)))

53 (assert-equal #\o (cell-char (grid-ref g 6 1)))

54 ;; Cells before and after untouched

55 (assert-equal #\space (cell-char (grid-ref g 1 1)))

56 (assert-equal #\space (cell-char (grid-ref g 7 1)))))

58 (test "grid-write-string! truncates at edge"

59 (let ((g (make-grid 5 1)))

60 (grid-write-string! g 3 0 "Hello" color-default color-default attr-none)

61 ;; Only 2 chars fit at col 3 in width-5 grid

62 (assert-equal #\H (cell-char (grid-ref g 3 0)))

63 (assert-equal #\e (cell-char (grid-ref g 4 0))))))

65 (test-group "fill-rect"

66 (test "grid-fill-rect! fills area"

67 (let ((g (make-grid 10 5)))

68 (grid-fill-rect! g 1 1 3 2 #\# color-yellow color-default attr-none)

69 ;; Inside the rect

70 (assert-equal #\# (cell-char (grid-ref g 1 1)))

71 (assert-equal #\# (cell-char (grid-ref g 3 2)))

72 ;; Outside the rect

73 (assert-equal #\space (cell-char (grid-ref g 0 0)))

74 (assert-equal #\space (cell-char (grid-ref g 4 1))))))

76 (test-group "grid-clear!"

77 (test "clear resets all cells"

78 (let ((g (make-grid 5 3)))

79 (grid-write-string! g 0 0 "Hello" color-red color-default attr-none)

80 (grid-clear! g)

81 (assert-equal #\space (cell-char (grid-ref g 0 0)))

82 (assert-equal -1 (cell-fg (grid-ref g 0 0))))))

84 (test-group "diffing"

85 (test "identical grids produce empty diff"

86 (let ((a (make-grid 10 5))

87 (b (make-grid 10 5)))

88 (assert-equal "" (grid-diff a b))))

90 (test "single cell change"

91 (let ((prev (make-grid 5 3))

92 (curr (make-grid 5 3)))

93 (grid-set! curr 2 1 #\X color-red color-default attr-none)

94 (let ((diff (grid-diff prev curr)))

95 ;; Should contain cursor move, SGR, and the character

96 (assert-true (> (string-length diff) 0))

97 ;; The diff should end with a reset sequence

98 (assert-true (> (string-length diff) 3)))))

100 (test "adjacent changes skip cursor repositioning"

101 (let ((prev (make-grid 10 3))

102 (curr (make-grid 10 3)))

103 (grid-write-string! curr 2 1 "AB" color-green color-default attr-none)

104 (let ((diff (grid-diff prev curr)))

105 ;; Should have one cursor move, not two

106 (assert-true (> (string-length diff) 0)))))

107

108 (test "style changes emit new SGR"

109 (let ((prev (make-grid 10 3))

110 (curr (make-grid 10 3)))

111 (grid-set! curr 0 0 #\A color-red color-default attr-none)

112 (grid-set! curr 1 0 #\B color-blue color-default attr-none)

113 (let ((diff (grid-diff prev curr)))

114 ;; Two different styles means two SGR sequences

115 (assert-true (> (string-length diff) 10))))))

116

117 (test-group "grid-copy"

118 (test "copy creates independent grid"

119 (let* ((orig (make-grid 5 3))

120 (copy (grid-copy orig)))

121 (grid-set! copy 0 0 #\X color-red color-default attr-none)

122 ;; Original should be unchanged

123 (assert-equal #\space (cell-char (grid-ref orig 0 0)))

124 ;; Copy should have the change

125 (assert-equal #\X (cell-char (grid-ref copy 0 0))))))

126

127 (test-group "colors"

128 (test "color-rgb encodes correctly"

129 (let ((orange (color-rgb 255 128 0)))

130 ;; Should be > 255 (truecolor range)

131 (assert-true (> orange 255))))

132

133 (test "256-color passthrough"

134 (assert-equal 196 (color-256 196)))))