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 core)

15 (sigil test)

16 (sigil vt))

18;; ---- helpers --------------------------------------------------------------

19(define ESC "\x1b;")

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

22(define (vt* cols rows . feeds)

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

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

25 t))

27(define (rtrim s)

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

29 (cond ((= i 0) "")

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

31 (else (substring s 0 i)))))

32(define (rows-of t)

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

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

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

36(define (cell-at t row col)

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

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

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

41;; ==========================================================================

42;; plain text, C0, wrapping

43;; ==========================================================================

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

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

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

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

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

49 (test "CRLF: second line"

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

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

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

53 (test "CR overprint"

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

55 (test "BS then overprint"

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

57 (test "autowrap wraps"

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

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

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

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

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

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

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

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

66 (test "DECAWM off: no wrap"

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

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

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

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

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

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

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

74 (test "tab to col 8"

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

77;; ==========================================================================

78;; cursor movement

79;; ==========================================================================

80(test-group "cursor movement"

81 (test "CUP 3;4"

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

83 (test "CUU + CUB"

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

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

86 (test "CUP clamps"

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

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

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

90 (test "CUD + CUF"

91 (assert-equal (list 4 4)

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

93 (test "CHA column"

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

95 (test "VPA row keeps col"

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

98;; ==========================================================================

99;; erase / insert / delete

100;; ==========================================================================

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

102 (test "EL 0: erase to right"

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

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

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

106 (test "EL 2: whole line"

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

108 (test "ED 0: erase below"

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

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

111 (test "ED 1: erase above"

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

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

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

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

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

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

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

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

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

121 (test "DCH deletes chars"

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

123 (test "ECH erases chars in place"

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

125 (test "IL inserts a line"

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

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

128 (test "DL deletes a line"

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

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

131

132;; ==========================================================================

133;; scroll region

134;; ==========================================================================

135(test-group "scroll region"

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

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

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

139 (test "SU in region"

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

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

142 (test "SD in region"

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

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

145 (test "RI at region top"

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

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

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

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

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

151 (test "DECOM: home is region top"

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

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

154

155;; ==========================================================================

156;; SGR

157;; ==========================================================================

158(test-group "SGR"

159 (test "SGR bold red + reset"

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

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

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

163 (test "SGR italic+underline+inverse"

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

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

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

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

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

169 (test "SGR truecolor fg"

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

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

172 (test "SGR colon syntax"

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

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

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

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

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

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

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

180 (test "SGR bright fg + 39 default"

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

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

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

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

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

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

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

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

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

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

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

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

193

194;; ==========================================================================

195;; alt screen

196;; ==========================================================================

197(test-group "alt screen"

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

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

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

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

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

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

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

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

206 (test "alt: no scrollback"

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

208

209;; ==========================================================================

210;; DECSC/DECRC, DECALN, RIS

211;; ==========================================================================

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

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

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

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

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

217 (test "DECALN fills E"

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

219 (test "RIS clears + resets SGR"

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

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

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

223

224;; ==========================================================================

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

226;; ==========================================================================

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

228 (test "OSC 0 BEL: title"

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

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

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

232 (test "OSC 2 ST: title"

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

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

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

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

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

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

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

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

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

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

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

244 (test "bracketed paste off"

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

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

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

248 (test "IRM: chars shift right"

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

250 (test "mouse-mode flags parsed"

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

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

253 (test "mouse-mode flags cleared"

254 (assert-equal vt-mouse-1006

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

256

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

258;; replies (DSR / DA)

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

260(test-group "replies"

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

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

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

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

265 (test "DSR 5: status ok"

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

267 (test "DA reply"

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

269

270;; ==========================================================================

271;; the trust boundary

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

273(test-group "trust boundary"

274 (test "huge params clamp"

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

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

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

278 (test "truncated SGR ignored"

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

280 (test "DCS swallowed"

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

282 (test "CHT clamps"

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

284 (test "unknown modes/charsets swallowed"

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

286 (test "escape split across chunks"

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

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

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

290

291;; ==========================================================================

292;; incremental UTF-8 (byte feed)

293;; ==========================================================================

294(test-group "incremental UTF-8"

295 (test "utf-8 across chunks"

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

318 (test "DL never scrollbacks"

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

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

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

322

323;; ==========================================================================

324;; damage tracking

325;; ==========================================================================

326(test-group "damage"

327 (test "damage: one row / drained"

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

329 (vt-take-damage! t)

330 (vt-feed! t "x")

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

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

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

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

335 (test "ED marks all its rows"

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

337 (vt-take-damage! t)

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

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

340 (test "scroll damages the region"

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

342 (vt-take-damage! t)

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

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

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

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

347

348;; ==========================================================================

349;; resize

350;; ==========================================================================

351(test-group "resize"

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

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

354 (vt-resize! t 5 4)

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

356 (vt-resize! t 20 4)

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

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

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

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

361 (vt-resize! t 10 3)

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

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

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

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

366 (vt-resize! t 10 2)

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

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

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

370 (test "grow pulls back out of scrollback"

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

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

373 (vt-resize! t 10 4)

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

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

376 (test "post-resize feed is sane"

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

378 (vt-resize! t 8 3)

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

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

381

382;; ==========================================================================

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

384;; ==========================================================================

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

386 (test "run wraps across the margin"

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

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

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

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

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

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

393 (vt-feed! t "f")

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

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

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

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

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

399 (test "esc splits runs, text intact"

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

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

402 (test "insert mode shifts, not overwrites"

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

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

405 (test "mixed unicode intact"

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

407

408;; ==========================================================================

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

410;; ==========================================================================

411(test-group "row-runs"

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

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

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

415 (assert-equal 1 (length runs))

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

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

418 (test "style change splits runs"

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

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

421 (assert-equal 2 (length runs))

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

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

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

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

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

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

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

429 (assert-equal 3 (length runs))

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

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

432 (test "blank row -> no runs"

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

434

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

452 (n (vector-length row)))

453 (let loop ((i 0))

454 (when (< i n)

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

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

457 (loop (+ i 1)))))))

458

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

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

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

462 (vt-resize! t 132 3)

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

464 (assert-true (pair? runs))

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

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

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

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

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

470 (if (null? rs)

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

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

473

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

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

476 ;; width nor the new width.

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

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

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

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

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

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

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

484 (let loop ((r 0))

485 (when (< r 8)

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

487 (n (vector-length row)))

488 (let loop2 ((i 0))

489 (when (< i n)

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

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

492 (loop2 (+ i 1)))))

493 (loop (+ r 1)))))))