test/test-folio-doc-reader.sgl

1;;; F1b -- `(folio doc reader)`, the `#lang folio/doc` profile.

2;;;

3;;; WHAT IS ASSERTED HERE AND WHAT IS ASSERTED ELSEWHERE, because the split is

4;;; deliberate rather than incidental:

5;;;

6;;; * DELEGATION PARITY is `test/f1b-parity-probe.sgl`, a direct script,

7;;; because it compares two whole manuscripts loaded through two languages

8;;; and wants the full canonical datum including every srcloc.

9;;; * PUBLICATION FALLBACK is `test/f1b-publication-probe.sgl`, a direct

10;;; script, because `(sigil doc render html)` reaches `(sigil shell)` and

11;;; under `sigil test` the whole FILE fails to load -- which would take every

12;;; arm below down with it, silently trading real assertions for one load

13;;; error.

14;;; * THE NO-EXECUTION WITNESS is `test/f1b-witness-load.sgl` driven from the

15;;; gate, because each manuscript needs its OWN process for "no marker" to

16;;; be a fact about one manuscript.

17;;; * THE PROFILE'S DECLARATIONS are `test/f1b-profile-probe.sgl`, which

18;;; deliberately links no author runtime.

19;;;

20;;; This file is the reader's own behaviour: roots, prelude, refusals, and the

21;;; ambient-profile mechanics.

22;;;

23;;; A NOTE ON HOW REFUSALS ARE ASSERTED, and do NOT "simplify" it later. Two

24;;; instruments are used on purpose:

25;;;

26;;; OCCURRENCE through `load`, i.e. the real `#lang` path.

27;;; WORDING through a direct call, because the `#lang` path DISCARDS a

28;;; reader's exception message -- `compiler.c:530-532` builds its wrapper from

29;;; the C-level `vm->error_message`, which is empty for a Scheme-level raise,

30;;; so every loader sees `read-language-source failed for #lang folio/doc: `

31;;; with nothing after the colon. This is not folio-specific: a stock

32;;; `#lang sigil/doc` file with no `@article` loses sigil-doc's own root

33;;; diagnostic identically. Filed as [[t-2f2af1]].

34;;;

35;;; WHEN THAT TICKET LANDS THE TWO ARMS MERGE; neither is deleted. Written down

36;;; because the redundancy looks removable and removing the wrong half silently

37;;; deletes the wording assertion.

38(import (sigil test) (sigil core) (sigil fs) (sigil syntax)

39 (sigil doc model) (sigil doc reader)

40 (prefix (sigil doc private author-runtime) sd:)

41 (folio doc) (folio doc reader) (folio doc profile) (folio doc inspect))

43;; ---------------------------------------------------------------------------

44;; helpers

45;; ---------------------------------------------------------------------------

46(define L (make-srcloc "f1b-suite" 1 1 0 0))

48(define (message thunk)

49 (guard (exn (else (exception-message exn))) (thunk) "NO-RAISE"))

51(define (string-has? haystack needle)

52 (let ((h (string-length haystack)) (n (string-length needle)))

53 (let loop ((i 0))

54 (cond ((> (+ i n) h) #f)

55 ((string=? needle (substring haystack i (+ i n))) #t)

56 (else (loop (+ i 1)))))))

58;; `read-language-source` takes the context the compiler would have built. The

59;; header offset is the byte length of `#lang folio/doc\n`, which is 16 and is

60;; computed rather than written so a rename of the language cannot silently

61;; shift every position this file asserts.

62(define folio-header-end (+ (string-length "#lang folio/doc") 1))

63(define (context-for name)

64 (list (cons source-name: name) (cons header-end-offset: folio-header-end)))

65(define (read-source path)

66 (read-language-source (read-file-string path) (context-for path)))

68;; The manuscript is loaded ONCE and stashed. `load` evaluates into the

69;; CALLER's module, so a second load of a different manuscript would rebind

70;; `document-roots` underneath any arm still using it.

71(define note-roots #f)

72(define (roots)

73 (if note-roots note-roots

74 (begin (load "test/fixtures/f1b-note.sgd")

75 (set! note-roots (eval 'document-roots))

76 note-roots)))

78(define (section-named container id)

79 (let loop ((xs container))

80 (cond ((null? xs) (error (string-append "no section with id " id)))

81 ((and (section? (car xs)) (string=? (section-id (car xs)) id)) (car xs))

82 (else (loop (cdr xs))))))

84(define (count-matching pred xs)

85 (let loop ((rest xs) (n 0))

86 (if (null? rest) n (loop (cdr rest) (if (pred (car rest)) (+ n 1) n)))))

88;; ---------------------------------------------------------------- the profile

90(test "the document profile names folio's two roots and admits several of them"

91 (assert-equal "folio/doc" (document-profile-name folio-document-profile))

92 (assert-equal '(note project) (document-profile-roots folio-document-profile))

93 ;; `'one-or-more` is not a convenience: a folio file legitimately closes a

94 ;; @project root and opens a @note root, which `f1b-note.sgd` does.

95 (assert-equal 'one-or-more (document-profile-multiplicity folio-document-profile)))

97(test "the profile owns its aggregates -- mutating the returned root list cannot widen it"

98 (let ((borrowed (document-profile-roots folio-document-profile)))

99 (set-car! borrowed 'chapter)

100 (assert-equal '(note project) (document-profile-roots folio-document-profile))))

101

102;; ------------------------------------------------------- roots and the tree

103

104(test "a folio manuscript with two roots parses to both, in manuscript order"

105 (let ((rs (roots)))

106 (assert-equal 2 (length rs))

107 (assert-true (note? (car rs)))

108 (assert-true (project? (cadr rs)))

109 (assert-equal "topics/f1b-reader" (note-id (car rs)))

110 (assert-equal "projects/f1b" (project-id (cadr rs)))))

111

112(test "a @section under a note holds folio work items -- the acceptance criterion"

113 ;; This is the shape SD-P7 exists to make possible, and before it this

114 ;; manuscript could not be represented at all: a `@task` inside a `@section`

115 ;; died in `author-normalize` against `document-node?`, long before

116 ;; `make-section` was reached.

117 (let* ((children (note-children (car (roots))))

118 (tasks-section (section-named children "tasks"))

119 (kids (section-children tasks-section)))

120 (assert-equal 2 (count-matching task? kids))

121 (assert-equal 1 (count-matching related? kids))

122 (assert-equal 1 (count-matching query? kids))

123 (assert-equal 1 (count-matching transclude? kids))

124 ;; THE POSITIVE CONTROL for the whole arm: a profile that admitted work

125 ;; items by accepting EVERYTHING would satisfy every count above just as

126 ;; well. An ordinary block must still be legal here.

127 (assert-true (> (count-matching paragraph? kids) 0))))

128

129(test "a SECOND section holds work items too, so the arm covers a set rather than one"

130 (let* ((children (note-children (car (roots))))

131 (decisions (section-children (section-named children "decisions"))))

132 (assert-equal 1 (count-matching decision? decisions))

133 (assert-equal 1 (count-matching question? decisions))

134 (assert-equal 1 (count-matching update? decisions))

135 (assert-true (> (count-matching paragraph? decisions) 0))))

136

137(test "structural containers still nest under a project, not under a section"

138 (let* ((kids (project-children (cadr (roots))))

139 (m (car (let loop ((xs kids)) (if (milestone? (car xs)) xs (loop (cdr xs)))))))

140 (assert-equal "m-reader" (milestone-id m))

141 (assert-equal 2 (count-matching phase? (milestone-children m)))))

142

143(test "a @related body becomes its LABEL as inline nodes, not as a paragraph"

144 ;; A brace body at a block boundary is lowered as a bare-prose RUN, so the

145 ;; label arrives as a single paragraph and `make-related` refuses it with

146 ;; "label must hold inline nodes". The unwrap is the exact mirror of

147 ;; `block-children` in `(sigil doc author)`, which wraps the other way.

148 (let* ((children (note-children (car (roots))))

149 (kids (section-children (section-named children "tasks")))

150 (rel (car (let loop ((xs kids)) (if (related? (car xs)) xs (loop (cdr xs)))))))

151 (assert-equal 'depends-on (related-kind rel))

152 (assert-equal "topics/folio-doc-frozen-vocabulary" (related-document rel))

153 (assert-true (pair? (related-label rel)))

154 (assert-true (inline-node? (car (related-label rel))))))

155

156;; --------------------------------------------------- laundering, all four kinds

157

158;; WHICH REFUSALS SURVIVE `load`, MEASURED -- this is narrower than the header

159;; says and the difference decides how each arm below is written.

160;;

161;; Only errors raised INSIDE `read-language-source` are truncated: the author-form

162;; refusal, sigil-doc's root-policy diagnostics, and its GRAMMAR diagnostics (the

163;; `fail-at` strings D1/D2 pin byte for byte -- verified: an unterminated `@p`

164;; under `#lang sigil/doc` also reports an empty cause). Errors raised while

165;; EVALUATING the syntax the reader returned keep their full message, because

166;; they never pass through the compiler's `#lang` wrapper at all.

167;;

168;; So laundering and duplicate-id refusals -- both evaluation-time -- are

169;; asserted at full wording through `load`, which is the strongest available

170;; instrument, and only the reader-time refusals need the direct-call second

171;; instrument.

172(test "a section may not re-nest a milestone, and the refusal is LOCATED at the child"

173 (let ((raised (message (lambda () (load "test/fixtures/f1b-laundering.sgd")))))

174 (assert-true (string-has? raised "folio/doc:"))

175 (assert-true (string-has? raised "structural container"))

176 ;; The location is the OFFENDING CHILD's, not the section's -- SD-P7's

177 ;; mandatory item 1. Line 22 of that fixture is the `@milestone` line; the

178 ;; enclosing `@section` opens at line 18.

179 (assert-true (string-has? raised "f1b-laundering.sgd:22:1:"))

180 (assert-true (not (string-has? raised "f1b-laundering.sgd:18:")))))

181

182(test "the laundering refusal's WORDING names folio's class and locates the child"

183 ;; Asserted through the constructor rather than through `load`, because the

184 ;; `#lang` path discards the message. See this file's header.

185 (let* ((child (make-milestone "m-smuggled" "smuggled" 'planned '()

186 (make-srcloc "f1b-launder.sgd" 42 7 100 20)))

187 (raised (message (lambda ()

188 (make-section-with-profile folio-content-profile "s"

189 (list (make-text "t" L)) (list child) L)))))

190 (assert-true (string-has? raised "folio/doc:"))

191 (assert-true (string-has? raised "structural container"))

192 (assert-true (string-has? raised "f1b-launder.sgd:42:7:"))))

193

194(test "a section may not re-nest a phase either"

195 (let ((raised (message (lambda () (load "test/fixtures/f1b-laundering-phase.sgd")))))

196 (assert-true (string-has? raised "folio/doc:"))

197 (assert-true (string-has? raised "structural container"))

198 (assert-true (string-has? raised "f1b-laundering-phase.sgd:14:1:"))))

199

200(test "a section may not re-nest a ROOT container -- the two extra declared witnesses"

201 ;; Fable's ruling names `milestone` and `phase`. folio declares all four

202 ;; structural containers refused, because a `note` re-nested inside a section

203 ;; launders exactly as badly and leaving it to an undeclared predicate property

204 ;; would keep half a known class in the silent position the ruling exists to

205 ;; eliminate. This arm is the evidence for the extra two.

206 (let ((raised (message (lambda () (load "test/fixtures/f1b-laundering-root.sgd")))))

207 (assert-true (string-has? raised "folio/doc:"))

208 (assert-true (string-has? raised "structural container"))

209 (assert-true (string-has? raised "f1b-laundering-root.sgd:14:1:"))))

210

211(test "an ordinary block in the SAME section position is still accepted"

212 ;; The refusal must be SPECIFIC, not total. Without this every arm above is

213 ;; satisfied by a profile that refuses everything.

214 (let ((s (make-section-with-profile folio-content-profile "s"

215 (list (make-text "t" L))

216 (list (make-paragraph (list (make-text "ordinary" L)) L)) L)))

217 (assert-true (section? s))

218 (assert-equal 1 (length (section-children s)))))

219

220;; --------------------------------------------------------------- identity

221

222(test "duplicate node ids are refused, naming BOTH occurrences and preferring neither"

223 (let ((raised (message (lambda () (load "test/fixtures/f1b-duplicate.sgd")))))

224 (assert-true (string-has? raised "id t-dup is declared 2 times"))

225 (assert-true (string-has? raised "f1b-duplicate.sgd:4:1"))

226 (assert-true (string-has? raised "f1b-duplicate.sgd:11:1"))

227 (assert-true (string-has? raised "none is preferred"))))

228

229(test "the uniqueness check is EVALUATION-time, not read-time, and that layering is pinned"

230 ;; Reading the manuscript produces forms without complaint; the refusal fires

231 ;; when those forms are evaluated. Pinned because it is what lets the arm

232 ;; above assert full wording through `load` at all: if the check ever moved

233 ;; INTO the reader, that arm would silently degrade to the compiler's

234 ;; truncated cause and keep passing on a far weaker assertion.

235 (let ((forms (message (lambda () (read-source "test/fixtures/f1b-duplicate.sgd")))))

236 (assert-equal "NO-RAISE" forms)))

237

238(test "core anchor ids live in a SEPARATE namespace: repeats WARN, never refuse"

239 ;; Reopened by Fable after M0 measured the estate-scale cost. These were one

240 ;; namespace, and a document repeating `## Log` -- which this estate does

241 ;; constantly -- was REFUSED ENTIRELY. The defect was the merge, not the

242 ;; strictness: a folio node id is a SEMANTIC address whose authority is the

243 ;; document; a section id is a RENDERING anchor whose authority is the rendered

244 ;; page, and merging them lets a render concern veto a semantic parse.

245 ;;

246 ;; REOPEN TRIGGER: this assumes core nodes are NOT semantically addressable

247 ;; (no `@related[node:]` targeting a section). That is F4's open decision; if

248 ;; F4 rules them addressable, the namespaces re-merge for addressing.

249 (let ((raised (message (lambda () (load "test/fixtures/f1b-repeated-section.sgd")))))

250 (assert-equal "NO-RAISE" raised)))

251

252(test "a task id EQUAL to a section slug is permitted -- different namespaces"

253 (let ((raised (message (lambda () (load "test/fixtures/f1b-cross-namespace.sgd")))))

254 (assert-equal "NO-RAISE" raised)))

255

256(test "a CORE section id colliding with a task id is ACCEPTED, not refused"

257 ;; F1a's SECOND disclosed deferral, RE-DISPOSED. The collision is real and

258 ;; still matters, but it belongs to the publication index at render time, not

259 ;; to a parse-time whole-document refusal.

260 (let ((raised (message (lambda () (load "test/fixtures/f1b-duplicate-section.sgd")))))

261 (assert-equal "NO-RAISE" raised)))

262

263(test "a document whose ids are all distinct is ACCEPTED -- the uniqueness positive control"

264 ;; Byte-for-byte the shape of the duplicate fixture with one id changed.

265 ;; Without it, "the reader refuses duplicates" is equally consistent with

266 ;; "the reader refuses everything".

267 (let ((forms (read-source "test/fixtures/f1b-unique.sgd")))

268 (assert-true (pair? forms))

269 (assert-equal 3 (length forms))))

270

271(test "the reader and F2a's inspector AGREE on where an id and a title live"

272 ;; The inspector reads a node's id from the FIRST POSITIONAL and its title from

273 ;; the `title:` KEYWORD, and nowhere else. A reader that disagreed would make

274 ;; every accepted document report `missing-node-id` against a file it had just

275 ;; parsed. The revision is synthetic on purpose: this arm is about identity

276 ;; extraction, not content identity, and the inspector validates its SHAPE.

277 (let* ((source (read-file-string "test/fixtures/f1b-note.sgd"))

278 (d (inspect-folio-source source "test/fixtures/f1b-note.sgd"

279 "sha256:0000000000000000000000000000000000000000000000000000000000000000"

280 folio-header-end))

281 (bad (let loop ((ds (descriptor-diagnostics d)) (n 0))

282 (if (null? ds) n

283 (loop (cdr ds)

284 (if (memq (diagnostic-code (car ds))

285 '(missing-node-id duplicate-node-id dangling-keyword))

286 (+ n 1) n))))))

287 (assert-true (descriptor-parsed? d))

288 (assert-equal 0 bad)

289 ;; ...and the inspector really did see the ids, or a zero above would mean

290 ;; it never looked.

291 (assert-equal 'unique (descriptor-id-status d "t-delegate"))

292 (assert-equal 'unique (descriptor-id-status d "m-reader"))

293 (assert-equal 'absent (descriptor-id-status d "t-not-in-this-document"))))

294

295;; ------------------------------------------------------------- author forms

296

297(test "a manuscript containing author forms is REFUSED through the real #lang path"

298 (let ((raised (message (lambda () (load "test/fixtures/f1b-witness-folio.sgd")))))

299 (assert-true (string-has? raised "read-language-source failed"))))

300

301(test "the author-form refusal's WORDING counts them and names the located ones"

302 (let ((raised (message (lambda () (read-source "test/fixtures/f1b-witness-folio.sgd")))))

303 (assert-true (string-has? raised "may not contain author forms"))

304 (assert-true (string-has? raised "found 9"))

305 (assert-true (string-has? raised "f1b-witness-folio.sgd:2:2"))

306 ;; A hoisted inline expression carries the parser's GENERATED srcloc, not

307 ;; its manuscript position, so it is counted and named rather than given a

308 ;; position that looks real and is not.

309 (assert-true (string-has? raised "hoisted inline expression"))

310 (assert-true (not (string-has? raised "<sigil/doc-generated>")))))

311

312(test "a manuscript with NO author forms is accepted -- the refusal is not total"

313 (let ((forms (read-source "test/fixtures/f1b-note.sgd")))

314 (assert-true (pair? forms))))

315

316(test "the emitted prelude is the three documented forms, and imports the profile installer"

317 ;; The prelude is the INSTALLATION POINT: `(folio doc author)` is imported

318 ;; instead of `(sigil doc private author-runtime)`, so the names the parser

319 ;; calls by bare name resolve to wrappers. `(sigil doc author)` stays whole so

320 ;; `@section`, `@p` and the rest are reused rather than reimplemented.

321 (let* ((forms (read-source "test/fixtures/f1b-note.sgd"))

322 (prelude (syntax->datum (car forms))))

323 (assert-equal 3 (length forms))

324 (assert-equal 'import (car prelude))

325 (assert-true (member '(folio doc author) (cdr prelude)))

326 (assert-true (member '(sigil doc author) (cdr prelude)))

327 (assert-true (member '(folio doc) (cdr prelude)))

328 ;; The raw author runtime must NOT be imported, or the profile is never

329 ;; installed and every section falls back to `block-node?`.

330 (assert-true (not (member '(sigil doc private author-runtime) (cdr prelude))))))

331

332(test "the emitted body checks identity uniqueness across ALL roots, not inside one"

333 (let* ((forms (read-source "test/fixtures/f1b-note.sgd"))

334 (body (syntax->datum (cadr forms))))

335 (assert-equal 'define (car body))

336 (assert-equal 'document-roots (cadr body))

337 (assert-equal 'folio-require-unique-ids (car (caddr body)))

338 (assert-equal 'document-roots (syntax->datum (caddr forms)))))

339

340;; -------------------------------------------------- leaf nodes and empty bodies

341

342(test "@query and @transclude refuse a non-empty body -- they are the two childless records"

343 ;; Asserted through manuscripts rather than by calling the commands directly: a

344 ;; folio command outside an `author-at` extent cannot even ask for its own

345 ;; location, so a direct call would fail for a reason unrelated to the rule

346 ;; under test -- and would pass a naive "it raised" assertion while proving

347 ;; nothing.

348 (let ((q (message (lambda () (load "test/fixtures/f1b-query-body.sgd"))))

349 (t (message (lambda () (load "test/fixtures/f1b-transclude-body.sgd")))))

350 (assert-true (string-has? q "@query takes no children"))

351 (assert-true (string-has? q "@query[...]{}"))

352 (assert-true (string-has? t "@transclude takes no children"))))

353

354(test "a BRACKET-ONLY leaf node fails as a NAMED BLOCK, which is the inherited trap"

355 ;; `@query[...]` with no body at all does NOT fail as an unknown form: it opens

356 ;; a named block and demands `@end query`, so the parse dies at the enclosing

357 ;; `@end note` instead. F2a found it, SD-P7 hit it twice, and both recorded

358 ;; that it fails in a way which LOOKS like the thing you were testing. Pinned

359 ;; so the next reader meets it as a test rather than as a lost afternoon.

360 ;;

361 ;; This refusal IS read-time, so only occurrence survives `load`.

362 (let ((raised (message (lambda () (load "test/fixtures/f1b-bracket-only.sgd")))))

363 (assert-true (string-has? raised "read-language-source failed"))

364 (assert-true (not (string=? raised "NO-RAISE")))))

365

366;; ------------------------------------------------- the ambient content profile

367

368(test "outside any extent the ambient profile is sigil/doc's, not folio's"

369 (assert-eq sigil-doc-content-profile (sd:author-content-profile)))

370

371(test "inside a folio extent the ambient profile is folio's, and a work item is legal there"

372 (sd:with-content-profile folio-content-profile

373 (lambda ()

374 (assert-eq folio-content-profile (sd:author-content-profile))

375 (let ((s (make-section-with-profile (sd:author-content-profile) "s"

376 (list (make-text "t" L))

377 (list (make-task "t-inside" "inside" 'ready #f '() #f '() L)) L)))

378 (assert-equal 1 (length (section-children s)))))))

379

380(test "LEAVING an extent restores the outer profile -- on the normal path"

381 (sd:with-content-profile folio-content-profile (lambda () #t))

382 (assert-eq sigil-doc-content-profile (sd:author-content-profile)))

383

384(test "LEAVING an extent restores the outer profile -- on the RAISING path"

385 ;; Ambient state's real hazard is leaking, and the raising path is the one a

386 ;; save-and-restore spelling gets wrong.

387 (message (lambda ()

388 (sd:with-content-profile folio-content-profile

389 (lambda () (error "deliberate")))))

390 (assert-eq sigil-doc-content-profile (sd:author-content-profile)))

391

392(test "loading a folio manuscript does not widen sigil/doc afterwards"

393 ;; The leak assertion, from the CONSUMING side. By the time this runs a folio

394 ;; manuscript has been loaded and evaluated several times over.

395 (roots)

396 (assert-eq sigil-doc-content-profile (sd:author-content-profile))

397 (let ((raised (message (lambda ()

398 (make-section-with-profile sigil-doc-content-profile "s"

399 (list (make-text "t" L))

400 (list (make-task "t-after" "after" 'ready #f '() #f '() L)) L)))))

401 (assert-true (string-has? raised "wrong semantic category"))))

402

403(test "ENTERING is deliberately not symmetric, and the floor is what makes that safe"

404 ;; SD-P7 ruled the asymmetry deliberate: nothing installs a profile on the way

405 ;; IN, so a `sigil/doc` manuscript evaluated inside a folio extent sees folio's

406 ;; profile. That is safe because the anti-narrowing floor makes any inherited

407 ;; ambient profile a SUPERSET of sigil/doc's -- asserted here across the whole

408 ;; core floor rather than on a sample, so "safe" is measured and not argued.

409 ;; F1b is NOT one of the three reopen triggers and does not fix this.

410 (sd:with-content-profile folio-content-profile

411 (lambda ()

412 (let ((child? (content-profile-section-child-predicate (sd:author-content-profile))))

413 (for-each (lambda (w) (assert-true (child? w))) (core-block-witnesses))))))