test/vt-test.sgl — sigil-vt

1;;; Conformance suite for (sigil vt) — the native VT core.

2;;;

3;;; A faithful port of slate's test/term-test.sgl (the emulator's behavior IS

4;;; the spec). Each fixture feeds a byte/escape sequence into a fresh emulator

5;;; and asserts the resulting grid text, cursor, attrs, or mode flags. Covers

6;;; the MUST tier: C0, CSI cursor/erase/insert/delete/scroll-region, SGR

7;;; 16/256/truecolor (+ colon sub-params), alt-screen, autowrap (incl. the

8;;; deferred-wrap edge), tabs, DECSC/DECRC, origin mode, DECALN, OSC title,

9;;; DECSCUSR, bracketed paste, DSR/DA replies, scrollback, resize, incremental

10;;; UTF-8 across chunk boundaries, the ground-state bulk-run fast path, the

11;;; trust boundary (hostile input), plus the native additions (events, mouse

12;;; flags, row-runs).

14(import (sigil test)

15 (sigil vt))

17;; ---- helpers --------------------------------------------------------------

18(define ESC "\x1b;")

19(define (csi . parts) (apply string-append ESC "[" parts))

21(define (vt* cols rows . feeds)

22 (let ((t (vt-make cols rows)))

23 (for-each (lambda (s) (vt-feed! t s)) feeds)

24 t))

26(define (rtrim s)

27 (let loop ((i (string-length s)))

28 (cond ((= i 0) "")

29 ((char=? (string-ref s (- i 1)) #\space) (loop (- i 1)))

30 (else (substring s 0 i)))))

31(define (rows-of t)

32 (let loop ((i (- (vt-rows t) 1)) (acc '()))

33 (if (< i 0) acc (loop (- i 1) (cons (rtrim (vt-row-text t i)) acc)))))

34(define (cursor-of t) (list (vt-cursor-row t) (vt-cursor-col t)))

35(define (cell-at t row col)

36 (let ((c (vector-ref (vt-row-cells t row) col)))

37 (list (string (integer->char (vt-cell-ch c)))

38 (vt-cell-attr c) (vt-cell-fg c) (vt-cell-bg c))))

40;; ==========================================================================

41;; plain text, C0, wrapping

42;; ==========================================================================

43(test-group "print / C0 / wrap"

44 (test "print: text lands on row 0"

45 (let ((t (vt* 10 3 "hello")))

46 (assert-equal (list "hello" "" "") (rows-of t))

47 (assert-equal (list 0 5) (cursor-of t))))

48 (test "CRLF: second line"

49 (let ((t (vt* 10 3 "ab\r\ncd")))

50 (assert-equal (list "ab" "cd" "") (rows-of t))

51 (assert-equal (list 1 2) (cursor-of t))))

52 (test "CR overprint"

53 (assert-equal (list "Xbc" "" "") (rows-of (vt* 10 3 "abc\rX"))))

54 (test "BS then overprint"

55 (assert-equal (list "aX" "" "") (rows-of (vt* 10 3 "ab\x08;X"))))

56 (test "autowrap wraps"

57 (let ((t (vt* 10 3 "0123456789AB")))

58 (assert-equal (list "0123456789" "AB" "") (rows-of t))

59 (assert-equal (list 1 2) (cursor-of t))))

60 (test "pending wrap: cursor stays on last col, CR cancels"

61 (let ((t (vt* 10 3 "0123456789")))

62 (assert-equal (list 0 9) (cursor-of t))

63 (vt-feed! t "\rX")

64 (assert-equal (list "X123456789" "" "") (rows-of t))))

65 (test "DECAWM off: no wrap"

66 (assert-equal (list "012345678B" "" "")

67 (rows-of (vt* 10 3 (csi "?7l") "0123456789AB"))))

68 (test "LF at bottom scrolls; evicted row to scrollback"

69 (let ((t (vt* 5 2 "aa\r\nbb\r\ncc")))

70 (assert-equal (list "bb" "cc") (rows-of t))

71 (assert-equal 1 (vt-scrollback-count t))

72 (assert-true (= (vt-cell-ch (vector-ref (vt-scrollback-row t 0) 0)) 97))))

73 (test "tab to col 8"

74 (assert-equal (list "a b" "") (rows-of (vt* 20 2 "a\tb")))))

76;; ==========================================================================

77;; DEC Special Graphics (tmux/ncurses line drawing)

78;; ==========================================================================

79(test-group "DEC Special Graphics"

80 (test "G0 line drawing returns to ASCII"

81 (assert-equal (list "┌──┐qq" "")

82 (rows-of (vt* 20 2 ESC "(0lqqk" ESC "(Bqq"))))

83 (test "G1 designation waits for SO; SI restores G0"

84 (assert-equal (list "q─│q" "")

85 (rows-of (vt* 20 2 ESC ")0q\x0e;qx\x0f;q"))))

86 (test "byte feeds preserve designation and invocation across chunks"

87 (let ((t (vt-make 20 2)))

88 (for-each (lambda (b) (vt-feed-bytes! t (list b)))

89 '(27 41 48 14 108 113 107 15 113))

90 (assert-equal (list "┌─┐q" "") (rows-of t))))

91 (test "string feeds preserve a split designation"

92 (assert-equal (list "─q" "")

93 (rows-of (vt* 20 2 ESC "(" "0" "q" ESC "(B" "q"))))

94 (test "Unicode and ASCII outside the graphics range are unchanged"

95 (assert-equal (list "AZ_─é─" "")

96 (rows-of (vt* 20 2 ESC "(0AZ_─éq"))))

97 (test "all DEC glyphs"

98 (assert-equal (list "◆▒␉␌␍␊°±␤␋┘┐┌└┼⎺⎻─⎼⎽├┤┴┬│≤≥π≠£·" "")

99 (rows-of (vt* 40 2 ESC "(0`abcdefghijklmnopqrstuvwxyz{|}~"))))

100 (test "DECSC/DECRC restores designations and active set"

101 (assert-equal (list "─q" "")

102 (rows-of (vt* 20 2 ESC ")0\x0e;" ESC "7"

103 ESC ")B\x0f;" ESC "8q\x0f;q"))))

104 (test "alternate screen return restores graphics state"

105 (assert-equal (list "─q" "")

106 (rows-of (vt* 20 2 ESC "(0" (csi "?1049h")

107 ESC "(B" (csi "?1049l") "q" ESC "(Bq"))))

108 (test "reset clears both designations and invocation"

109 (assert-equal (list "qq" "")

110 (rows-of (vt* 20 2 ESC "(0" ESC ")0\x0e;"

111 ESC "cq\x0e;q"))))

112 (test "insert mode uses the same graphics translation"

113 (assert-equal (list "─AB" "")

114 (rows-of (vt* 20 2 "AB\r" (csi "4h") ESC "(0q"))))

115 (test "escape and cancellation interrupt an incomplete designation"

116 (assert-equal (list "q──" "")

117 (rows-of (vt* 20 2 ESC "(\x18;q" ESC "("

118 ESC "(0q" ESC "(\x1a;q"))))

119 (test "graphics remain Unicode in scrollback and row runs"

120 (let ((t (vt* 5 2 ESC "(0lqqk\r\nx x\r\nmqqj")))

121 (assert-equal #x250c

122 (vt-cell-ch (vector-ref (vt-scrollback-row t 0) 0)))

123 (assert-equal "│ │" (vector-ref (car (vt-row-runs t 0)) 0)))))

124

125;; ==========================================================================

126;; cursor movement

127;; ==========================================================================

128(test-group "cursor movement"

129 (test "CUP 3;4"

130 (assert-equal (list "" "" " X" "" "") (rows-of (vt* 10 5 (csi "3;4H") "X"))))

131 (test "CUU + CUB"

132 (assert-equal (list "" " X" "" "" "")

133 (rows-of (vt* 10 5 (csi "3;4H") (csi "A") (csi "2D") "X"))))

134 (test "CUP clamps"

135 (let ((t (vt* 10 5 "abc" (csi "10;20H") "Z")))

136 (assert-equal (list "abc" "" "" "" " Z") (rows-of t))

137 (assert-equal (list 4 9) (cursor-of t))))

138 (test "CUD + CUF"

139 (assert-equal (list 4 4)

140 (cursor-of (vt* 10 5 (csi "2;2H") (csi "3B") (csi "2C") "X"))))

141 (test "CHA column"

142 (assert-equal (list "hi X" "" "" "" "") (rows-of (vt* 10 5 "hi" (csi "5G") "X"))))

143 (test "VPA row keeps col"

144 (assert-equal (list "hi" "" " X" "" "") (rows-of (vt* 10 5 "hi" (csi "3d") "X")))))

145

146;; ==========================================================================

147;; erase / insert / delete

148;; ==========================================================================

149(test-group "erase / insert / delete"

150 (test "EL 0: erase to right"

151 (assert-equal (list "abc" "" "") (rows-of (vt* 10 3 "abcdef" (csi "4G") (csi "K")))))

152 (test "EL 1: erase to left (incl cursor)"

153 (assert-equal (list " ef" "" "") (rows-of (vt* 10 3 "abcdef" (csi "4G") (csi "1K")))))

154 (test "EL 2: whole line"

155 (assert-equal (list "" "" "") (rows-of (vt* 10 3 "abcdef" (csi "2K")))))

156 (test "ED 0: erase below"

157 (assert-equal (list "aaaaaa" "bb" "")

158 (rows-of (vt* 6 3 "aaaaaa\r\nbbbbbb\r\ncccccc" (csi "2;3H") (csi "J")))))

159 (test "ED 1: erase above"

160 (assert-equal (list "" " bbb" "cccccc")

161 (rows-of (vt* 6 3 "aaaaaa\r\nbbbbbb\r\ncccccc" (csi "2;3H") (csi "1J")))))

162 (test "ED 2: erase all + cursor left on last col"

163 (let ((t (vt* 6 3 "aaaaaa\r\nbbbbbb" (csi "2J"))))

164 (assert-equal (list "" "" "") (rows-of t))

165 (assert-equal (list 1 5) (cursor-of t))))

166 (test "ICH inserts blanks (then overtyped)"

167 (assert-equal (list "abXYcdef" "" "")

168 (rows-of (vt* 10 3 "abcdef" (csi "3G") (csi "2@") "XY"))))

169 (test "DCH deletes chars"

170 (assert-equal (list "abef" "" "") (rows-of (vt* 10 3 "abcdef" (csi "3G") (csi "2P")))))

171 (test "ECH erases chars in place"

172 (assert-equal (list "ab ef" "" "") (rows-of (vt* 10 3 "abcdef" (csi "3G") (csi "2X")))))

173 (test "IL inserts a line"

174 (assert-equal (list "a" "" "b" "c")

175 (rows-of (vt* 5 4 "a\r\nb\r\nc\r\nd" (csi "2;1H") (csi "L")))))

176 (test "DL deletes a line"

177 (assert-equal (list "a" "c" "d" "")

178 (rows-of (vt* 5 4 "a\r\nb\r\nc\r\nd" (csi "2;1H") (csi "M"))))))

179

180;; ==========================================================================

181;; scroll region

182;; ==========================================================================

183(test-group "scroll region"

184 (test "DECSTBM: region scrolls, top intact"

185 (assert-equal (list "top" "l2" "l3" "l4" "")

186 (rows-of (vt* 5 5 "top" (csi "2;4r") (csi "2;1H") "l1\r\nl2\r\nl3\r\nl4"))))

187 (test "SU in region"

188 (assert-equal (list "a" "d" "" "" "e")

189 (rows-of (vt* 5 5 "a\r\nb\r\nc\r\nd\r\ne" (csi "2;4r") (csi "2S")))))

190 (test "SD in region"

191 (assert-equal (list "a" "" "b" "c" "e")

192 (rows-of (vt* 5 5 "a\r\nb\r\nc\r\nd\r\ne" (csi "2;4r") (csi "1T")))))

193 (test "RI at region top"

194 (assert-equal (list "a" "" "b" "c" "")

195 (rows-of (vt* 5 5 "a\r\nb\r\nc" (csi "2;4r") (csi "2;1H") ESC "M"))))

196 (test "non-top region scroll: no scrollback"

197 (assert-equal 0 (vt-scrollback-count

198 (vt* 5 5 "x\r\ny" (csi "2;4r") (csi "2;1H") "1\r\n2\r\n3\r\n4"))))

199 (test "DECOM: home is region top"

200 (assert-equal (list "" "X" "" "" "")

201 (rows-of (vt* 10 5 (csi "2;4r") (csi "?6h") (csi "1;1H") "X")))))

202

203;; ==========================================================================

204;; SGR

205;; ==========================================================================

206(test-group "SGR"

207 (test "SGR bold red + reset"

208 (let ((t (vt* 10 2 (csi "1;31m") "R" (csi "0m") "p")))

209 (assert-equal (list "R" vt-attr-bold 1 -1) (cell-at t 0 0))

210 (assert-equal (list "p" 0 -1 -1) (cell-at t 0 1))))

211 (test "SGR italic+underline+inverse"

212 (assert-equal (list "x" (+ vt-attr-italic vt-attr-underline vt-attr-inverse) -1 -1)

213 (cell-at (vt* 10 2 (csi "3;4;7m") "x") 0 0)))

214 (test "SGR 256-color fg/bg"

215 (assert-equal (list "c" 0 196 22)

216 (cell-at (vt* 10 2 (csi "38;5;196m") (csi "48;5;22m") "c") 0 0)))

217 (test "SGR truecolor fg"

218 (assert-equal (list "t" 0 (+ #x1000000 (* 255 65536) (* 128 256) 0) -1)

219 (cell-at (vt* 10 2 (csi "38;2;255;128;0m") "t") 0 0)))

220 (test "SGR colon syntax"

221 (assert-equal (list "Q" 0 99 -1) (cell-at (vt* 10 2 ESC "[38:5:99mQ") 0 0)))

222 (test "SGR colon colorspace form + following param"

223 (assert-equal (list "W" vt-attr-underline (+ #x1000000 (* 255 65536) (* 128 256) 0) -1)

224 (cell-at (vt* 10 2 ESC "[38:2::255:128:0;4mW") 0 0)))

225 (test "SGR colon truecolor (no colorspace)"

226 (assert-equal (list "V" 0 (+ #x1000000 (* 10 65536) (* 20 256) 30) -1)

227 (cell-at (vt* 10 2 ESC "[38:2:10:20:30mV") 0 0)))

228 (test "SGR bright fg + 39 default"

229 (let ((t (vt* 10 2 (csi "91m") "b" (csi "39m") "d")))

230 (assert-equal (list "b" 0 9 -1) (cell-at t 0 0))

231 (assert-equal (list "d" 0 -1 -1) (cell-at t 0 1))))

232 (test "SGR 22 clears bold, keeps color"

233 (assert-equal (list "b" 0 1 -1)

234 (cell-at (vt* 10 2 (csi "1;31m") "a" (csi "22m") "b") 0 1)))

235 (test "BCE: ED fills with cur bg"

236 (assert-equal 19 (vt-cell-bg (vector-ref (vt-row-cells (vt* 4 2 (csi "48;5;19m") (csi "2J")) 1) 3))))

237 (test "palette 16 = cube 0,0,0" (assert-equal 0 (vt-color-256->rgb 16)))

238 (test "palette 196 = red" (assert-equal #xff0000 (vt-color-256->rgb 196)))

239 (test "palette 231 = white" (assert-equal #xffffff (vt-color-256->rgb 231)))

240 (test "palette 244 gray" (assert-equal #x808080 (vt-color-256->rgb 244))))

241

242;; ==========================================================================

243;; alt screen

244;; ==========================================================================

245(test-group "alt screen"

246 (test "1049: alt starts cleared / restores main + cursor"

247 (let ((t (vt* 10 3 "main" (csi "?1049h") (csi "1;1H") "ALT")))

248 (assert-equal (list "ALT" "" "") (rows-of t))

249 (assert-true (vt-alt? t))

250 (vt-feed! t (csi "?1049l"))

251 (assert-equal (list "main" "" "") (rows-of t))

252 (assert-equal (list 0 4) (cursor-of t))

253 (assert-true (not (vt-alt? t)))))

254 (test "alt: no scrollback"

255 (assert-equal 0 (vt-scrollback-count (vt* 5 2 (csi "?1049h") "a\r\nb\r\nc\r\nd")))))

256

257;; ==========================================================================

258;; DECSC/DECRC, DECALN, RIS

259;; ==========================================================================

260(test-group "DECSC/DECRC, DECALN, RIS"

261 (test "DECSC/DECRC restores pos + SGR"

262 (let ((t (vt* 10 3 (csi "31m") (csi "2;3H") ESC "7" (csi "0m") (csi "1;1H") ESC "8" "X")))

263 (assert-equal (list "" " X" "") (rows-of t))

264 (assert-equal (list "X" 0 1 -1) (cell-at t 1 2))))

265 (test "DECALN fills E"

266 (assert-equal (list "EEE" "EEE") (rows-of (vt* 3 2 ESC "#8"))))

267 (test "RIS clears + resets SGR"

268 (let ((t (vt* 5 2 "hi" (csi "31m") ESC "c" "x")))

269 (assert-equal (list "x" "") (rows-of t))

270 (assert-equal (list "x" 0 -1 -1) (cell-at t 0 0)))))

271

272;; ==========================================================================

273;; OSC title, DECSCUSR, bracketed paste, modes, events

274;; ==========================================================================

275(test-group "OSC / modes / events"

276 (test "OSC 0 BEL: title"

277 (let ((t (vt* 10 2 ESC "]0;my title\x07;" "x")))

278 (assert-equal "my title" (vt-title t))

279 (assert-equal (list "x" "") (rows-of t))))

280 (test "OSC 2 ST: title"

281 (let ((t (vt* 10 2 ESC "]2;st title" ESC "\\" "y")))

282 (assert-equal "st title" (vt-title t))

283 (assert-equal (list "y" "") (rows-of t))))

284 (test "OSC 52 (clipboard) not in title, queued as event"

285 (let ((t (vt* 10 2 ESC "]52;c;aGVsbG8=\x07;" "z")))

286 (assert-equal "" (vt-title t))

287 (assert-equal (list "z" "") (rows-of t))

288 (let ((evs (vt-take-events! t)))

289 (assert-true (memv 'clipboard (map (lambda (e) (dict-ref e type: #f)) evs))))))

290 (test "DECSCUSR style" (assert-equal 4 (vt-cursor-style (vt* 10 2 (csi "4 q")))))

291 (test "bracketed paste on" (assert-true (vt-bracketed-paste? (vt* 10 2 (csi "?2004h")))))

292 (test "bracketed paste off"

293 (assert-true (not (vt-bracketed-paste? (vt* 10 2 (csi "?2004h") (csi "?2004l"))))))

294 (test "cursor hidden" (assert-true (not (vt-cursor-visible? (vt* 10 2 (csi "?25l"))))))

295 (test "app cursor mode" (assert-true (vt-app-cursor? (vt* 10 2 (csi "?1h")))))

296 (test "IRM: chars shift right"

297 (assert-equal (list "aXYbc" "") (rows-of (vt* 10 2 "abc" (csi "2G") (csi "4h") "XY"))))

298 (test "mouse-mode flags parsed"

299 (assert-equal (+ vt-mouse-1002 vt-mouse-1006)

300 (vt-mouse-flags (vt* 10 2 (csi "?1002h") (csi "?1006h")))))

301 (test "mouse-mode flags cleared"

302 (assert-equal vt-mouse-1006

303 (vt-mouse-flags (vt* 10 2 (csi "?1002h") (csi "?1006h") (csi "?1002l"))))))

304

305;; ==========================================================================

306;; replies (DSR / DA)

307;; ==========================================================================

308(test-group "replies"

309 (test "DSR 6: cursor report + drain"

310 (let ((t (vt* 10 5 (csi "3;4H") (csi "6n"))))

311 (assert-equal (string-append ESC "[3;4R") (vt-take-output! t))

312 (assert-equal "" (vt-take-output! t))))

313 (test "DSR 5: status ok"

314 (assert-equal (string-append ESC "[0n") (vt-take-output! (vt* 10 5 (csi "5n")))))

315 (test "DA reply"

316 (assert-equal (string-append ESC "[?6c") (vt-take-output! (vt* 10 5 (csi "c"))))))

317

318;; ==========================================================================

319;; the trust boundary

320;; ==========================================================================

321(test-group "trust boundary"

322 (test "huge params clamp"

323 (let ((t (vt* 10 2 ESC "[999999999999H" "ok")))

324 (assert-equal (list 1 2) (cursor-of t))

325 (assert-equal (list "" "ok") (rows-of t))))

326 (test "truncated SGR ignored"

327 (assert-equal (list "x" 0 -1 -1) (cell-at (vt* 10 2 ESC "[38;2m" "x") 0 0)))

328 (test "DCS swallowed"

329 (assert-equal (list "ok" "") (rows-of (vt* 10 2 ESC "P malicious dcs payload " ESC "\\" "ok"))))

330 (test "CHT clamps"

331 (assert-equal (list 0 9) (cursor-of (vt* 10 2 ESC "[999999999I" "x"))))

332 (test "unknown modes/charsets swallowed"

333 (assert-equal (list "ok" "") (rows-of (vt* 10 2 ESC "[?9999h" ESC "[<5m" ESC "(X" "ok"))))

334 (test "escape split across chunks"

335 (let ((t (vt-make 10 2)))

336 (vt-feed! t ESC) (vt-feed! t "[3") (vt-feed! t "1mX")

337 (assert-equal (list "X" 0 1 -1) (cell-at t 0 0)))))

338

339;; ==========================================================================

340;; incremental UTF-8 (byte feed)

341;; ==========================================================================

342(test-group "incremental UTF-8"

343 (test "utf-8 across chunks"

344 (let ((t (vt-make 10 2)))

345 (vt-feed-bytes! t (list 97 195))

346 (vt-feed-bytes! t (list 169 32 226 134))

347 (vt-feed-bytes! t (list 146))

348 (assert-equal "aé → " (vt-row-text t 0))))

349 (test "invalid utf-8 -> U+FFFD, stream recovers"

350 (let ((t (vt-make 10 2)))

351 (vt-feed-bytes! t (list 195 195 169))

352 (assert-true (and (= (vt-cell-ch (vector-ref (vt-row-cells t 0) 0)) 65533)

353 (= (vt-cell-ch (vector-ref (vt-row-cells t 0) 1)) 233)))))

354 (test "surrogate bytes -> U+FFFD"

355 (let ((t (vt-make 10 2)))

356 (vt-feed-bytes! t (list 237 160 128))

357 (assert-equal 65533 (vt-cell-ch (vector-ref (vt-row-cells t 0) 0)))))

358 (test "past-U+10FFFF -> U+FFFD"

359 (let ((t (vt-make 10 2)))

360 (vt-feed-bytes! t (list 244 144 128 128))

361 (assert-equal 65533 (vt-cell-ch (vector-ref (vt-row-cells t 0) 0)))))

362 (test "overlong encoding -> U+FFFD"

363 (let ((t (vt-make 10 2)))

364 (vt-feed-bytes! t (list 224 128 168))

365 (assert-equal 65533 (vt-cell-ch (vector-ref (vt-row-cells t 0) 0)))))

366 (test "DL never scrollbacks"

367 (let ((t (vt* 5 3 "a\r\nb\r\nc" (csi "1;1H") (csi "M"))))

368 (assert-equal 0 (vt-scrollback-count t))

369 (assert-equal (list "b" "c" "") (rows-of t)))))

370

371;; ==========================================================================

372;; damage tracking

373;; ==========================================================================

374(test-group "damage"

375 (test "damage: one row / drained"

376 (let ((t (vt-make 10 3)))

377 (vt-take-damage! t)

378 (vt-feed! t "x")

379 (let ((d (vt-take-damage! t)))

380 (assert-equal (list 0) (dict-ref d rows: '()))

381 (assert-true (not (dict-ref d all?: #f))))

382 (assert-equal '() (dict-ref (vt-take-damage! t) rows: '()))))

383 (test "ED marks all its rows"

384 (let ((t (vt-make 10 3)))

385 (vt-take-damage! t)

386 (vt-feed! t (csi "2J"))

387 (assert-equal (list 0 1 2) (dict-ref (vt-take-damage! t) rows: '()))))

388 (test "scroll damages the region"

389 (let ((t (vt-make 5 2)))

390 (vt-take-damage! t)

391 (vt-feed! t "a\r\nb\r\nc")

392 (let ((d (vt-take-damage! t)))

393 (assert-true (or (dict-ref d all?: #f)

394 (equal? (dict-ref d rows: '()) (list 0 1))))))))

395

396;; ==========================================================================

397;; resize

398;; ==========================================================================

399(test-group "resize"

400 (test "narrower truncates / wider pads / cols updated"

401 (let ((t (vt* 10 4 "aa\r\nbb")))

402 (vt-resize! t 5 4)

403 (assert-equal (list "aa" "bb" "" "") (rows-of t))

404 (vt-resize! t 20 4)

405 (assert-equal (list "aa" "bb" "" "") (rows-of t))

406 (assert-equal 20 (vt-cols t))))

407 (test "shrink drops blank bottom rows (no scrollback)"

408 (let ((t (vt* 10 5 "aa\r\nbb")))

409 (vt-resize! t 10 3)

410 (assert-equal (list "aa" "bb" "") (rows-of t))

411 (assert-equal 0 (vt-scrollback-count t))))

412 (test "shrink onto content keeps cursor rows, evicts to scrollback"

413 (let ((t (vt* 10 4 "a\r\nb\r\nc\r\nd")))

414 (vt-resize! t 10 2)

415 (assert-equal (list "c" "d") (rows-of t))

416 (assert-equal 2 (vt-scrollback-count t))

417 (assert-equal (list 1 1) (cursor-of t))))

418 (test "grow pulls back out of scrollback"

419 (let ((t (vt* 10 2 "a\r\nb\r\nc")))

420 (assert-equal 1 (vt-scrollback-count t))

421 (vt-resize! t 10 4)

422 (assert-equal (list "a" "b" "c" "") (rows-of t))

423 (assert-equal 0 (vt-scrollback-count t))))

424 (test "post-resize feed is sane"

425 (let ((t (vt* 10 4 (csi "2;3r") "x")))

426 (vt-resize! t 8 3)

427 (vt-feed! t (string-append (csi "3;1H") "\n\n"))

428 (assert-true (>= (vt-rows t) 3)))))

429

430;; ==========================================================================

431;; the ground-state bulk-run fast path

432;; ==========================================================================

433(test-group "bulk-run fast path"

434 (test "run wraps across the margin"

435 (let ((t (vt* 5 3 "abcdefgh")))

436 (assert-equal (list "abcde" "fgh" "") (rows-of t))

437 (assert-equal (list 1 3) (cursor-of t))))

438 (test "run deferred wrap parks / fires next char"

439 (let ((t (vt* 5 3 "abcde")))

440 (assert-equal (list 0 4) (cursor-of t))

441 (vt-feed! t "f")

442 (assert-equal (list "abcde" "f" "") (rows-of t))))

443 (test "run no-autowrap overwrites last col"

444 (let ((t (vt* 5 3 (csi "?7l") "abcdefgh")))

445 (assert-equal (list "abcdh" "" "") (rows-of t))

446 (assert-equal (list 0 4) (cursor-of t))))

447 (test "esc splits runs, text intact"

448 (assert-equal (list "abcdef" "" "")

449 (rows-of (vt* 10 3 (string-append "ab" (csi "31m") "cd" (csi "0m") "ef")))))

450 (test "insert mode shifts, not overwrites"

451 (assert-equal (list "XYabc" "" "")

452 (rows-of (vt* 10 3 "abc" (csi "1;1H") (csi "4h") "XY"))))

453 (test "mixed unicode intact"

454 (assert-equal (list "aλbμc" "" "") (rows-of (vt* 10 3 "aλbμc")))))

455

456;; ==========================================================================

457;; row-runs (the render seam) — new native primitive

458;; ==========================================================================

459(test-group "row-runs"

460 (test "plain run merges to one, right-trimmed"

461 (let* ((t (vt* 10 2 "hello"))

462 (runs (vt-row-runs t 0)))

463 (assert-equal 1 (length runs))

464 (assert-equal "hello" (vector-ref (car runs) 0))

465 (assert-equal 0 (vector-ref (car runs) 1))))

466 (test "style change splits runs"

467 (let* ((t (vt* 10 2 "ab" (csi "31m") "cd"))

468 (runs (vt-row-runs t 0)))

469 (assert-equal 2 (length runs))

470 (assert-equal "ab" (vector-ref (car runs) 0))

471 (assert-equal "cd" (vector-ref (cadr runs) 0))

472 (assert-equal 1 (vector-ref (cadr runs) 2))))

473 (test "cursor-col forces a break with cursor? flag"

474 (let* ((t (vt* 10 2 "hello"))

475 (runs (vt-row-runs t 0 1)))

476 ;; "h" | "e"(cursor) | "llo"

477 (assert-equal 3 (length runs))

478 (assert-true (vector-ref (cadr runs) 4))

479 (assert-equal "e" (vector-ref (cadr runs) 0))))

480 (test "blank row -> no runs"

481 (assert-equal '() (vt-row-runs (vt-make 10 2) 1)))

482

483 ;; ---- t-d4c7: a history row keeps the width it was PUSHED at -------------

484 ;; Ring rows are allocated at the cols in effect when they scrolled off and

485 ;; are never re-widthed (xterm no-rewrap). Reading one at t->cols after a

486 ;; WIDENING resize runs off the end of the allocation: a heap over-read whose

487 ;; garbage got rendered into the terminal (DoS via integer->char, plus

488 ;; disclosure of adjacent heap). These call the REAL readers — the fuzz

489 ;; harness cannot, since VT_FUZZ compiles the Sigil glue out.

490 (test "scrollback row keeps its push width (no over-read on widen)"

491 (let ((t (vt-make 40 3)))

492 (vt-feed! t "aaaa\r\nbbbb\r\ncccc\r\ndddd\r\neeee\r\n")

493 (assert-true (> (vt-scrollback-count t) 0))

494 (vt-resize! t 132 3) ; widen; history stays 40 wide

495 (assert-equal 132 (vt-cols t))

496 ;; the row is returned at ITS width, not the grid's

497 (assert-equal 40 (vector-length (vt-scrollback-row t 0)))

498 ;; and every cell is a real codepoint, not heap garbage

499 (let* ((row (vt-scrollback-row t 0))

500 (n (vector-length row)))

501 (let loop ((i 0))

502 (when (< i n)

503 (let ((cp (vt-cell-ch (vector-ref row i))))

504 (assert-true (and (>= cp 0) (<= cp 1114111))))

505 (loop (+ i 1)))))))

506

507 (test "scrollback runs after widen stay in-bounds"

508 (let ((t (vt-make 40 3)))

509 (vt-feed! t "hello\r\nworld\r\nagain\r\nmore1\r\nmore2\r\n")

510 (vt-resize! t 132 3)

511 (let ((runs (vt-scrollback-runs t 0)))

512 (assert-true (pair? runs))

513 ;; TOTAL rendered width must not exceed the row's real width. Asserting

514 ;; per-RUN length instead would silently pass on the bug: over-read

515 ;; garbage has erratic attrs, so it splits into many SHORT runs that are

516 ;; each under the limit while the row as a whole runs far over.

517 (let loop ((rs runs) (total 0))

518 (if (null? rs)

519 (assert-true (<= total 40))

520 (loop (cdr rs) (+ total (string-length (vector-ref (car rs) 0)))))))))

521

522 ;; The resize PULL had the same root cause with a different guess (ocols, not

523 ;; t->cols) — only wrong after TWO resizes, when ocols is neither the push

524 ;; width nor the new width.

525 (test "resize pull uses the row's push width, not ocols"

526 (let ((t (vt-make 40 3)))

527 (vt-feed! t "aaaa\r\nbbbb\r\ncccc\r\ndddd\r\neeee\r\n")

528 (vt-resize! t 80 3) ; ocols becomes 80...

529 (vt-resize! t 132 8) ; ...but history rows are 40 wide

530 (assert-equal 132 (vt-cols t))

531 ;; pulled-back rows must be real content, not garbage

532 (let loop ((r 0))

533 (when (< r 8)

534 (let* ((row (vt-row-cells t r))

535 (n (vector-length row)))

536 (let loop2 ((i 0))

537 (when (< i n)

538 (let ((cp (vt-cell-ch (vector-ref row i))))

539 (assert-true (and (>= cp 0) (<= cp 1114111))))

540 (loop2 (+ i 1)))))

541 (loop (+ r 1)))))))