test/test-markdown.sgl — sigil-markdown

1(import (sigil test)

2 (sigil markdown))

4;; Minimal SXML accessors for these tests. The standalone (sigil sxml)

5;; library is no longer part of this package's dependency set (SXML helpers

6;; now live in sigil-wasm-dom), so we define the few accessors the tests

7;; need locally rather than pulling in a UI dependency for testing.

8(define (sxml-tag node) (car node))

10(define (sxml-has-attrs? node)

11 (and (pair? (cdr node))

12 (pair? (cadr node))

13 (eq? (car (cadr node)) '@)))

15(define (sxml-attributes node)

16 (if (sxml-has-attrs? node)

17 (cdr (cadr node))

18 '()))

20(define (sxml-content node)

21 (if (sxml-has-attrs? node)

22 (cddr node)

23 (cdr node)))

25;; ============================================================

26;; Headings

27;; ============================================================

29(test-group "headings"

30 (test "h1"

31 (let ((doc (markdown->sxml "# Hello")))

32 (assert-equal 'h1 (sxml-tag (car (sxml-content doc))))))

34 (test "h2"

35 (let ((doc (markdown->sxml "## Sub")))

36 (assert-equal 'h2 (sxml-tag (car (sxml-content doc))))))

38 (test "h3"

39 (let ((doc (markdown->sxml "### Third")))

40 (assert-equal 'h3 (sxml-tag (car (sxml-content doc))))))

42 (test "h6"

43 (let ((doc (markdown->sxml "###### Deepest")))

44 (assert-equal 'h6 (sxml-tag (car (sxml-content doc)))))))

46;; ============================================================

47;; Paragraphs

48;; ============================================================

50(test-group "paragraphs"

51 (test "single paragraph"

52 (let* ((doc (markdown->sxml "Hello world"))

53 (content (sxml-content doc)))

54 (assert-equal 'p (sxml-tag (car content)))))

56 (test "multiple paragraphs separated by blank lines"

57 (let* ((doc (markdown->sxml "First\n\nSecond"))

58 (content (sxml-content doc)))

59 (assert-equal 2 (length content))

60 (assert-equal 'p (sxml-tag (car content)))

61 (assert-equal 'p (sxml-tag (cadr content))))))

63;; ============================================================

64;; Code blocks

65;; ============================================================

67(test-group "code blocks"

68 (test "fenced code block"

69 (let* ((doc (markdown->sxml "```\ncode here\n```"))

70 (content (sxml-content doc))

71 (block (car content)))

72 (assert-equal 'pre (sxml-tag block))))

74 (test "fenced with language tag"

75 (let* ((doc (markdown->sxml "```scheme\n(+ 1 2)\n```"))

76 (content (sxml-content doc))

77 (block (car content)))

78 (assert-equal 'pre (sxml-tag block)))))

80;; ============================================================

81;; Lists

82;; ============================================================

84(test-group "lists"

85 (test "unordered list"

86 (let* ((doc (markdown->sxml "- one\n- two\n- three"))

87 (content (sxml-content doc))

88 (list-elem (car content)))

89 (assert-equal 'ul (sxml-tag list-elem))))

91 (test "ordered list"

92 (let* ((doc (markdown->sxml "1. first\n2. second"))

93 (content (sxml-content doc))

94 (list-elem (car content)))

95 (assert-equal 'ol (sxml-tag list-elem)))))

97;; ============================================================

98;; Inline formatting

99;; ============================================================

100

101(test-group "inline formatting"

102 (test "bold"

103 (let ((result (parse-inline "**bold**")))

104 (assert-true (pair? result))

105 ;; Should contain a strong element

106 (assert-true (pair? (filter (lambda (x)

107 (and (pair? x) (eq? (car x) 'strong)))

108 result)))))

109

110 (test "italic"

111 (let ((result (parse-inline "*italic*")))

112 (assert-true (pair? result))

113 (assert-true (pair? (filter (lambda (x)

114 (and (pair? x) (eq? (car x) 'em)))

115 result)))))

116

117 (test "inline code"

118 (let ((result (parse-inline "`code`")))

119 (assert-true (pair? result))

120 (assert-true (pair? (filter (lambda (x)

121 (and (pair? x) (eq? (car x) 'code)))

122 result)))))

123

124 (test "link"

125 (let ((result (parse-inline "[text](http://example.com)")))

126 (assert-true (pair? result))

127 (assert-true (pair? (filter (lambda (x)

128 (and (pair? x) (eq? (car x) 'a)))

129 result)))))

130

131 (test "image"

132 (let ((result (parse-inline "![alt](image.png)")))

133 (assert-true (pair? result))

134 (assert-true (pair? (filter (lambda (x)

135 (and (pair? x) (eq? (car x) 'img)))

136 result))))))

137

138;; ============================================================

139;; Intraword underscores are not emphasis delimiters

140;; ============================================================

141;;

142;; An underscore between two word characters is ordinary text, per

143;; CommonMark. Before this rule existed, every snake_case identifier written

144;; as prose was silently eaten: `sokol_gfx and sokol_gp` became

145;; `sokolgfx and sokolgp`, live on a public site.

146;;

147;; THE STRINGS BELOW ARE COPIED FROM THE REAL CORPUS -- Azoth estate READMEs

148;; and commit messages -- not invented. A case written from the same

149;; understanding that produced the bug tends to satisfy the buggy rule too;

150;; these cannot drift from what the estate actually renders.

151;;

152;; The assertion is TEXT-IDENTITY, not "no em node present". Absence of a

153;; symptom passes for free if the parser drops the input entirely; equality

154;; with the source string does not.

155

156(define (inline-text result)

157 (let flatten ((n result) (acc ""))

158 (cond ((string? n) (string-append acc n))

159 ((and (pair? n) (symbol? (car n)))

160 ;; skip the tag, and an (@ ...) attribute list if present

161 (let ((rest (if (and (pair? (cdr n)) (pair? (cadr n))

162 (eq? (car (cadr n)) '@))

163 (cddr n)

164 (cdr n))))

165 (flatten rest acc)))

166 ((pair? n) (flatten (cdr n) (flatten (car n) acc)))

167 (else acc))))

168

169(define (assert-literal source)

170 (assert-equal source (inline-text (parse-inline source))))

171

172(test-group "intraword underscores"

173 ;; --- from README.md of sigil-graphics, rendered wrong on azoth.works ---

174 (test "sokol_gfx and sokol_gp survive"

175 (assert-literal "Provides 2D rendering capabilities via sokol_gfx and sokol_gp"))

176

177 (test "stb_image and stb_truetype survive"

178 (assert-literal "image loading (stb_image), and font rendering (stb_truetype)."))

179

180 ;; --- from real commit messages in the estate ---

181 (test "sigil_wasm_gles3 survives"

182 (assert-literal "sigil_wasm_gles3 and sigil_wasm_native_start"))

183

184 (test "KILN_ARTIFACTS survives"

185 (assert-literal "KILN_ARTIFACTS and KILN_DEPS"))

186

187 (test "group_id, node_id, run_groups survive"

188 (assert-literal "group_id, node_id, plan_form and run_groups"))

189

190 ;; --- the boundary cases the rule must NOT break ---

191 (test "__init__ is still strong"

192 (let ((result (parse-inline "__init__ method")))

193 (assert-true (pair? (filter (lambda (x) (and (pair? x) (eq? (car x) 'strong)))

194 result)))

195 (assert-equal "init method" (inline-text result))))

196

197 (test "_emphasis_ at a word boundary still works"

198 (let ((result (parse-inline "an _emphasis_ here")))

199 (assert-true (pair? (filter (lambda (x) (and (pair? x) (eq? (car x) 'em)))

200 result)))

201 (assert-equal "an emphasis here" (inline-text result))))

202

203 ;; CommonMark: _foo_bar_ is foo_bar. The inner underscore is

204 ;; intraword and the outer pair is not, so the run closes at the LAST one.

205 (test "_foo_bar_ emphasises across the intraword underscore"

206 (let ((result (parse-inline "_foo_bar_")))

207 (assert-true (pair? (filter (lambda (x) (and (pair? x) (eq? (car x) 'em)))

208 result)))

209 (assert-equal "foo_bar" (inline-text result))))

210

211 ;; The '*' rule is deliberately DIFFERENT and must not change with it.

212 ;; This is the negative control: had the fix been applied to both

213 ;; characters, this test goes red.

214 (test "intraword ASTERISK is still emphasis"

215 (let ((result (parse-inline "foo*bar*baz")))

216 (assert-true (pair? (filter (lambda (x) (and (pair? x) (eq? (car x) 'em)))

217 result)))

218 (assert-equal "foobarbaz" (inline-text result)))))

219

220;; ============================================================

221;; Front matter

222;; ============================================================

223

224(test-group "front matter"

225 (test "YAML front matter parsed"

226 (let* ((doc (markdown->sxml "---\ntitle: Hello\n---\n\n# Content"))

227 (attrs (sxml-attributes doc)))

228 (assert-true (pair? attrs))))

229

230 (test "no front matter returns empty attributes"

231 (let* ((doc (markdown->sxml "# Just a heading"))

232 (attrs (sxml-attributes doc)))

233 (assert-equal '() attrs))))

234

235;; ============================================================

236;; Integration

237;; ============================================================

238

239(test-group "markdown->sxml integration"

240 (test "full document"

241 (let ((doc (markdown->sxml "# Title\n\nA paragraph.\n\n- item 1\n- item 2")))

242 (assert-equal 'document (sxml-tag doc))

243 (assert-true (>= (length (sxml-content doc)) 3)))))

244

245(run-tests)

246

247;; ============================================================

248;; Nested lists

249;;

250;; These pin BOTH meanings of "nested" that this package's history has

251;; confused. Twice the word appeared in docs and in the 0.9.2 perf

252;; investigation meaning INLINE nesting -- emphasis inside emphasis, a

253;; strong run inside a list item -- which made nested LISTS look covered

254;; when they were never implemented at all.

255;;

256;; The flattening was inherited from the original PEG parser. 0.9.2's

257;; hand-written scanners were gated on byte-identical output against

258;; goldens generated from that parser, so they reproduced the defect

259;; faithfully. The goldens were not wrong about what the old parser did;

260;; the old parser was wrong.

261;; ============================================================

262

263(define (li-tags doc)

264 ;; tags of the direct children of the first list in the document

265 (map (lambda (n) (if (pair? n) (sxml-tag n) n))

266 (sxml-content (car (sxml-content doc)))))

267

268(define (nth-li doc n)

269 (list-ref (sxml-content (car (sxml-content doc))) n))

270

271(test-group "nested lists"

272 (test "flat list stays flat"

273 (let ((doc (markdown->sxml "- one\n- two\n- three")))

274 (assert-equal 'ul (sxml-tag (car (sxml-content doc))))

275 (assert-equal 3 (length (sxml-content (car (sxml-content doc)))))))

276

277 (test "two-level unordered nests"

278 (let* ((doc (markdown->sxml "- top\n - inner\n- back"))

279 (ul (car (sxml-content doc)))

280 (items (sxml-content ul)))

281 ;; two TOP-LEVEL items, not three siblings

282 (assert-equal 2 (length items))

283 ;; the first item carries a nested ul

284 (assert-equal 'ul (sxml-tag (car (filter pair? (cdr (car items))))))))

285

286 (test "three-level unordered nests"

287 (let* ((doc (markdown->sxml "- a\n - b\n - c\n- d"))

288 (items (sxml-content (car (sxml-content doc)))))

289 (assert-equal 2 (length items))))

290

291 (test "ordered nested under unordered keeps its type"

292 (let* ((doc (markdown->sxml "- top\n 1. first\n 2. second"))

293 (items (sxml-content (car (sxml-content doc))))

294 (inner (car (filter pair? (cdr (car items))))))

295 (assert-equal 1 (length items))

296 (assert-equal 'ol (sxml-tag inner))))

297

298 ;; THE CASE THAT MISLED EVERYONE: inline nesting and list nesting in one

299 ;; document. Both must work, and they are different things.

300 (test "inline emphasis and a nested list coexist"

301 (let* ((doc (markdown->sxml "- **bold** item\n - *inner* item"))

302 (items (sxml-content (car (sxml-content doc))))

303 (top (car items))

304 (inner (car (filter pair? (cdr top)))))

305 (assert-equal 1 (length items))

306 ;; inline nesting still works on the parent

307 (assert-equal 'strong (sxml-tag (car (filter pair? (cdr top)))))

308 ;; ...and is not confused with the nested list

309 (assert-equal 'ul (sxml-tag (list-ref (filter pair? (cdr top)) 1)))))

310 ;; Nesting is decided by the parent ITEM's CONTENT column, not by the

311 ;; list's marker indent. "10. " puts content at column 4, so a dash at

312 ;; column 2 is NOT inside it and must start its own list. A first cut of

313 ;; this fix compared against the list indent instead and silently

314 ;; swallowed the dash list into the ordered item -- caught only by the

315 ;; golden corpus, because every unit test here used a plain 2-space

316 ;; indent that both rules satisfy.

317 (test "shallower item of another type is not absorbed"

318 (let* ((doc (markdown->sxml "10. wide marker\n - dash at two"))

319 (blocks (sxml-content doc)))

320 (assert-equal 2 (length blocks))

321 (assert-equal 'ol (sxml-tag (car blocks)))

322 (assert-equal 'ul (sxml-tag (cadr blocks)))))

323

324 (test "item reaching the content column does nest"

325 (let* ((doc (markdown->sxml "10. wide marker\n - dash at four"))

326 (blocks (sxml-content doc)))

327 (assert-equal 1 (length blocks))

328 (assert-equal 'ol (sxml-tag (car blocks)))))

329

330 ;; The dedent is load-bearing and was NOT covered until a sabotage run

331 ;; showed the suite staying green with it removed. Four-space nesting is

332 ;; common, and 4+ leading spaces is also the INDENTED CODE BLOCK trigger:

333 ;; without dedenting before re-parsing, " - b" becomes a (pre ...)

334 ;; instead of a nested list. Two-space nesting never exercises this,

335 ;; which is why every earlier test missed it.

336 (test "four-space nesting is a list, not a code block"

337 (let* ((doc (markdown->sxml "- a\n - b"))

338 (top (car (sxml-content (car (sxml-content doc)))))

339 (inner (car (filter pair? (cdr top)))))

340 (assert-equal 'ul (sxml-tag inner))

341 (assert-equal 'li (sxml-tag (car (sxml-content inner))))))

342

343 (test "deep four-space nesting stays a list"

344 (let* ((doc (markdown->sxml "- a\n - b\n - c"))

345 (top (car (sxml-content (car (sxml-content doc)))))

346 (inner (car (filter pair? (cdr top))))

347 (deeper (car (filter pair? (cdr (car (sxml-content inner)))))))

348 (assert-equal 'ul (sxml-tag inner))

349 (assert-equal 'ul (sxml-tag deeper))))

350

351 ;; HTML comments. Before 0.9.4 these fell through to the paragraph case and

352 ;; rendered as escaped VISIBLE TEXT — which published a RELEASES.md authoring

353 ;; note onto usesigil.org, from a comment whose own first line read "this

354 ;; comment is not published".

355 ;;

356 ;; The two CONTROL tests below are the point: it is easy to write a stripper

357 ;; that also eats ordinary prose containing angle brackets, and a suite that

358 ;; only checked "the comment is gone" would pass for a parser that deleted

359 ;; far too much.

360

361 (test "multi-line HTML comment is not rendered"

362 (let ((doc (markdown->sxml "# T\n\n\n\nVisible.\n")))

363 (assert-equal '(document (h1 "T") (p "Visible.")) doc)))

364

365 (test "single-line HTML comment is not rendered"

366 (let ((doc (markdown->sxml "# T\n\n\n\nVisible.\n")))

367 (assert-equal '(document (h1 "T") (p "Visible.")) doc)))

368

369 (test "CONTROL: prose containing angle brackets survives"

370 (let ((doc (markdown->sxml "# T\n\na d\n")))

371 (assert-equal '(document (h1 "T") (p "a d")) doc)))

372

373 (test "CONTROL: a document with no comment is unchanged"

374 (let ((doc (markdown->sxml "# T\n\nVisible only.\n")))

375 (assert-equal '(document (h1 "T") (p "Visible only.")) doc)))

376

377 ;; CommonMark: an unterminated comment runs to end of document. Asserted so

378 ;; the behaviour is deliberate and discoverable rather than a surprise.

379 (test "unterminated comment consumes the rest, per CommonMark"

380 (let ((doc (markdown->sxml "# T\n\n<!-- oops\n\nSwallowed.\n")))

381 (assert-equal '(document (h1 "T")) doc))))