test/f1b-publication-probe.sgl

1;;; F1b -- publication fallback, FROM A READ MANUSCRIPT.

2;;;

3;;; WHAT IS NEW HERE, and it is the only reason this file exists alongside

4;;; `test/f1a-publication-probe.sgl`.

5;;;

6;;; F1a already proved that `query` and `transclude` render explicit unresolved

7;;; markers in plain text, HTML and Typst. It proved it from records built

8;;; PROGRAMMATICALLY: F1a ships no reader, so its evidence never routes through

9;;; the parser at all. Its own review says so, and says F1b is where that stops

10;;; being true. The property this phase owes is the same requirement measured

11;;; through the READER: a `.sgd` file, parsed by `(folio doc reader)`, lowered,

12;;; and rendered, still says what it said.

13;;;

14;;; The failure this guards is SILENT. A lowering that dropped a marker would

15;;; still produce valid HTML, still validate, still build a PDF, and simply say

16;;; less than the source did. Nothing errors.

17;;;

18;;; WHY A DIRECT SCRIPT AND NOT THE SUITE. `(sigil doc render html)`

19;;; transitively imports `(sigil doc presentation)` -> `(sigil doc verify)` ->

20;;; `(sigil shell)`/`(sigil process)`, which does not resolve inside this

21;;; package's native test harness -- the whole FILE fails to load, not just the

22;;; arm. So these renderings are asserted here instead.

23;;;

24;;; AND `(sigil test)` MUST NOT BE USED IN A DIRECT SCRIPT: such a run REGISTERS

25;;; `test` forms and never executes them. Measured by F1a -- a file asserting

26;;; `1 = 2` printed nothing and exited 0. The harness is hand-rolled and the

27;;; gate proves it can go red every run via `F1B_PROBE_SELFTEST`.

28(import (sigil core) (sigil fs) (sigil syntax) (folio doc)

29 (sigil doc model) (folio doc profile)

30 (sigil doc publication) (sigil doc render html)

31 (sigil doc print) (sigil doc render typst))

33(define checks-run 0)

34(define checks-failed 0)

35(define (check label ok?)

36 (set! checks-run (+ checks-run 1))

37 (if (not ok?)

38 (begin (set! checks-failed (+ checks-failed 1))

39 (display (string-append " FAIL: " label)) (newline))))

41(define (string-has? haystack needle)

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

43 (let loop ((i 0))

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

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

46 (else (loop (+ i 1)))))))

48;; ---------------------------------------------------------------------------

49;; PARSE. Through the real `#lang` path.

50;; ---------------------------------------------------------------------------

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

52(define note-root (car document-roots))

53(define project-root (cadr document-roots))

55(check "the manuscript parsed to two roots" (= (length document-roots) 2))

56(check "the first root is a note" (note? note-root))

57(check "the second root is a project" (project? project-root))

59;; The derived nodes have to actually BE in the parsed tree, or every marker

60;; assertion below is about a document that never contained one.

61(define note-has-query

62 (let loop ((xs (note-children note-root)))

63 (cond ((null? xs) #f)

64 ((query? (car xs)) #t)

65 ((section? (car xs))

66 (or (let inner ((ys (section-children (car xs))))

67 (cond ((null? ys) #f) ((query? (car ys)) #t) (else (inner (cdr ys)))))

68 (loop (cdr xs))))

69 (else (loop (cdr xs))))))

70(check "the parsed note really contains a query" note-has-query)

72;; ---------------------------------------------------------------------------

73;; LOWER once, render three ways.

74;; ---------------------------------------------------------------------------

75(define lowered (folio-document->publication note-root #f))

76(define plain-text (document->plain lowered))

77(define index (build-publication-index (list (make-publication-document "f1b" lowered))))

78(define html

79 (document->html-fragment lowered

80 (make-html-render-context index "f1b"

81 (lambda (target) (string-append "#" (publication-target-id target))) '() 2)))

82(define typst

83 (print-publication->typst

84 (make-print-publication "F1b read manuscript" #f '()

85 (list (make-publication-document "f1b" lowered)) '())))

87(define renderings (list (list "plain" plain-text) (list "html" html) (list "typst" typst)))

88(define (for-each-rendering proc)

89 (for-each (lambda (entry) (proc (car entry) (cadr entry))) renderings))

91;; A renderer that returned "" would satisfy every absence assertion below by

92;; having nothing in it -- the comparison that degenerates to comparing two

93;; nothings.

94(for-each-rendering

95 (lambda (name rendered)

96 (check (string-append name " rendering is non-trivial") (> (string-length rendered) 800))))

98;; ---------------------------------------------------------------------------

99;; THE MARKERS SURVIVE, AND THEY NAME THEIR TARGET.

100;;

101;; "A marker is present" is a weaker claim than it looks: `make-query` exists to

102;; refuse a query with neither id nor title precisely because such a node

103;; rendered as a bare `[unresolved folio query]`, satisfying every

104;; marker-is-present assertion while naming nothing. So each rendering is

105;; checked for the marker AND for the identity of what the reader is not seeing.

106;; ---------------------------------------------------------------------------

107;; THE WHOLE MARKER, PER NODE -- not the prefix, and not the id in isolation.

108;;

109;; FOUND BY SABOTAGE: deleting the query marker from `(folio doc unresolved)`

110;; left this probe GREEN. The prefix assertion was satisfied by the SIBLING

111;; TRANSCLUSION marker, and `q-open-work` survived as an appended string

112;; elsewhere in the rendering, so nothing that this probe checked actually

113;; depended on the query marker existing. An assertion satisfiable by a

114;; different node is not an assertion about this one.

115;;

116;; The expected text is DERIVED from the same function the renderer uses, so it

117;; cannot drift -- and the node it is derived from is pulled out of the parsed

118;; tree, so a manuscript edit moves both sides together.

119;; AND THE EXPECTATION MUST NOT SHARE AN IMPLEMENTATION WITH WHAT IT CHECKS.

120;;

121;; The first repair derived the expected text by calling `unresolved-query-text`

122;; on the parsed node -- THE SAME FUNCTION THE DEFECT LIVES IN. Sabotage caught

123;; it one round later: with the marker's id removed, the expectation lost its id

124;; too, both sides moved together, and the check passed on a defective product.

125;; A value compared against a re-serialization of itself agrees no matter what

126;; the code does.

127;;

128;; So the marker is LOCATED instead: find the span that starts at the query

129;; marker's opening and ends at its closing bracket, and require the id and title

130;; to live INSIDE that one span. That shares no code with the function under

131;; test, is not a reimplementation of its format, and still closes the hole this

132;; started from -- a sibling transclusion marker does not contain the query's id.

133(define (marker-span rendered)

134 (let* ((opening (string-append unresolved-marker-prefix "query"))

135 (n (string-length opening))

136 (h (string-length rendered)))

137 (let scan ((i 0))

138 (cond

139 ((> (+ i n) h) #f)

140 ((string=? opening (substring rendered i (+ i n)))

141 (let close ((j (+ i n)))

142 (cond ((>= j h) #f)

143 ((char=? (string-ref rendered j) #\]) (substring rendered i (+ j 1)))

144 (else (close (+ j 1))))))

145 (else (scan (+ i 1)))))))

146

147(for-each-rendering

148 (lambda (name rendered)

149 (check (string-append name " carries the unresolved-marker prefix")

150 (string-has? rendered unresolved-marker-prefix))

151 (let ((span (marker-span rendered)))

152 (check (string-append name " contains a located QUERY marker, not just the shared prefix")

153 (string? span))

154 (check (string-append name " names the query INSIDE its own marker span")

155 (and (string? span) (string-has? span "q-open-work")))

156 (check (string-append name " names the title INSIDE its own marker span")

157 (and (string? span) (string-has? span "Everything ready and unblocked"))))

158 (check (string-append name " names the unresolved query by id")

159 (string-has? rendered "q-open-work"))

160 (check (string-append name " names the unresolved query by title")

161 (string-has? rendered "Everything ready and unblocked"))

162 (check (string-append name " names the transclusion's target document")

163 (string-has? rendered "topics/sigil-doc-content-profiles"))

164 (check (string-append name " names the transclusion's target node")

165 (string-has? rendered "s-limits"))

166 ;; D12's sub-ruling: the two-part address is the ONLY spelling, so a marker

167 ;; must never teach a compact `doc#node` form the model refuses to accept.

168 (check (string-append name " does not invent a compact address spelling")

169 (not (string-has? rendered "topics/sigil-doc-content-profiles#")))))

170

171;; ---------------------------------------------------------------------------

172;; SEMANTIC FACTS SURVIVE THE LOWERING. A publication that dropped statuses

173;; would still be valid output that simply said less than the source did.

174;; ---------------------------------------------------------------------------

175(for-each-rendering

176 (lambda (name rendered)

177 (check (string-append name " keeps a task id") (string-has? rendered "t-delegate"))

178 (check (string-append name " keeps a task status word") (string-has? rendered "active"))

179 (check (string-append name " keeps a priority, separately from status")

180 (string-has? rendered "priority"))

181 (check (string-append name " keeps the update's attribution") (string-has? rendered "u-2026-08-12"))))

182

183;; The project root exercises the container kinds the note does not.

184(define project-plain (document->plain (folio-document->publication project-root #f)))

185(check "the project lowering keeps its milestone id" (string-has? project-plain "m-reader"))

186(check "the project lowering keeps its phase ids"

187 (and (string-has? project-plain "p-profile") (string-has? project-plain "p-parity")))

188(check "the project lowering keeps a container status word" (string-has? project-plain "done"))

189

190;; ---------------------------------------------------------------------------

191;; POSITIVE CONTROL, both directions. Without it every marker assertion above

192;; would also pass for a renderer that printed the marker unconditionally.

193;; ---------------------------------------------------------------------------

194(define control-location (make-srcloc "f1b-publication-control" 1 1 0 0))

195(define without-derived

196 (make-note "topics/f1b-control" "Control" '()

197 (list (make-paragraph (list (make-text "nothing derived in here" control-location))

198 control-location))

199 control-location))

200(define control-plain (document->plain (folio-document->publication without-derived #f)))

201(check "the control rendering is itself non-trivial" (> (string-length control-plain) 30))

202(check "no marker appears when no derived node is present"

203 (not (string-has? control-plain unresolved-marker-prefix)))

204(check "no query id appears when no query is present"

205 (not (string-has? control-plain "q-open-work")))

206

207;; ---------------------------------------------------------------------------

208;; FOLIO NODES NESTED INSIDE CORE CONTAINERS, not only inside a `@section`.

209;;

210;; The lowering descended into `section` ALONE until an adversarial review

211;; showed the argument for that was a non-sequitur: `section?` is itself a

212;; `block-node?`, so a section carrying work items nests inside an admonition, a

213;; list item, a table cell or an exercise, and every one of those reached

214;; `document->plain` unlowered and raised "unknown node".

215;;

216;; Three of those are exercised through a MANUSCRIPT. The table path is

217;; exercised PROGRAMMATICALLY instead -- a section inside a `@cell` is awkward to

218;; spell in a manuscript and the spelling is not the property under test; the

219;; code path is. Stated rather than quietly omitted.

220;; ---------------------------------------------------------------------------

221(load "test/fixtures/f1b-nested-containers.sgd")

222(define nested-root (car document-roots))

223(define nested-location (make-srcloc "f1b-nested-programmatic" 1 1 0 0))

224(define nested-plain

225 (document->plain (folio-document->publication nested-root #f)))

226(check "a task under a section under an ADMONITION survives lowering"

227 (string-has? nested-plain "t-in-aside"))

228(check "a decision under a section under a LIST ITEM survives lowering"

229 (string-has? nested-plain "d-in-item"))

230(check "a query under a section under an EXERCISE survives lowering"

231 (string-has? nested-plain "q-in-exercise"))

232;; THE DIRECT INVARIANT, which is what all nine containers are really about:

233;; NO FOLIO NODE SURVIVES INTO THE PUBLICATION TREE.

234;;

235;; The string checks above are per-container and useful, but they can only see

236;; containers whose contents reach the plain BODY. A `term` renders at the

237;; GLOSSARY, so `t-in-term` is legitimately absent from `document->plain` even

238;; when the term has been lowered correctly -- my first version of this check

239;; asserted the id appeared and failed on a CORRECT product, which is the same

240;; "assert the symptom, not the property" mistake in miniature.

241;;

242;; Walking the lowered tree for folio survivors tests the property itself, covers

243;; every container at once including any tenth one, and is exactly the

244;; measurement that exposed the bug: `FOLIO_SURVIVORS 1` with the rendering

245;; succeeding.

246(define (folio-survivors root)

247 (let walk ((n root) (count 0))

248 (if (folio-node? n)

249 (+ count 1)

250 (let loop ((xs (node-children n)) (c count))

251 (if (null? xs) c (loop (cdr xs) (walk (car xs) c)))))))

252(check "NO folio node survives lowering, across every core container"

253 (= 0 (folio-survivors (folio-document->publication nested-root #f))))

254;; ...and the detector must be able to COUNT one, or zero means nothing.

255(check "the survivor detector can see a folio node when one is present"

256 (= 1 (folio-survivors

257 (make-section-with-profile folio-content-profile "control"

258 (list (make-text "control" nested-location))

259 (list (make-task "t-survivor" "a deliberate survivor"

260 'ready #f '() #f '() nested-location))

261 nested-location))))

262;; ...and their FACTS survive, not merely their ids, or the lowering could be

263;; emitting a bare id and dropping the semantics.

264(check "the nested task keeps its status word" (string-has? nested-plain "[ready]"))

265(check "the nested decision keeps its status word" (string-has? nested-plain "[accepted]"))

266

267(define (para-at s) (make-paragraph (list (make-text s nested-location)) nested-location))

268(define table-with-folio

269 (make-note "topics/f1b-nested-table" "Table" '()

270 (list

271 (make-table #f '(left)

272 (list

273 (make-table-row #f

274 (list

275 (make-table-cell

276 (list

277 (make-section-with-profile folio-content-profile "in-cell"

278 (list (make-text "Inside a cell" nested-location))

279 (list (para-at "ordinary")

280 (make-task "t-in-cell" "A task in a table cell"

281 'ready #f '() #f '() nested-location))

282 nested-location))

283 nested-location))

284 nested-location))

285 nested-location))

286 nested-location))

287(define table-plain (document->plain (folio-document->publication table-with-folio #f)))

288(check "a task under a section under a TABLE CELL survives lowering"

289 (string-has? table-plain "t-in-cell"))

290(check "the table-cell task keeps its status word" (string-has? table-plain "[ready]"))

291

292;; ---------------------------------------------------------------------------

293;; Self-test.

294;; ---------------------------------------------------------------------------

295(if (getenv "F1B_PROBE_SELFTEST")

296 (check "deliberate failure injected by F1B_PROBE_SELFTEST" #f))

297

298(display (string-append "F1B_PUBLICATION_PROBE checks=" (number->string checks-run)

299 " failed=" (number->string checks-failed)))

300(newline)

301(if (> checks-failed 0)

302 (error "F1b publication probe failed" checks-failed))