Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
167 lines
4.3 KiB
Plaintext
167 lines
4.3 KiB
Plaintext
;; Extension — document integrity validation (tree-aware: descends into sections).
|
|
;; (Conformance loads section.sx before this suite.)
|
|
|
|
(st-bootstrap-classes!)
|
|
(content-bootstrap-blocks!)
|
|
(content-bootstrap-doc!)
|
|
(content-bootstrap-section!)
|
|
|
|
;; ── a fully valid document ──
|
|
(define
|
|
good
|
|
(doc-append
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-heading "h" 1 "Title"))
|
|
(mk-text "p" "Body"))
|
|
(mk-list "l" true (list "a" "b"))))
|
|
(content-test "valid doc is valid" (content/valid? good) true)
|
|
(content-test "valid doc no issues" (content/validate good) (list))
|
|
|
|
;; ── bad field types ──
|
|
(content-test
|
|
"heading bad level"
|
|
(content/issue-kinds
|
|
(doc-append (doc-empty "d") (mk-heading "h" "notnum" "T")))
|
|
(list "field"))
|
|
(content-test
|
|
"text bad type"
|
|
(content/issue-kinds
|
|
(doc-append (doc-empty "d") (mk-text "p" 42)))
|
|
(list "field"))
|
|
(content-test
|
|
"image two bad attrs"
|
|
(len
|
|
(content/validate
|
|
(doc-append (doc-empty "d") (mk-image "i" 1 2))))
|
|
2)
|
|
(content-test
|
|
"list bad ordered + items"
|
|
(len
|
|
(content/validate
|
|
(doc-append (doc-empty "d") (mk-list "l" "yes" "nope"))))
|
|
2)
|
|
(content-test
|
|
"valid image ok"
|
|
(content/valid?
|
|
(doc-append (doc-empty "d") (mk-image "i" "/a.png" "alt")))
|
|
true)
|
|
|
|
;; ── id checks ──
|
|
(content-test
|
|
"blank id"
|
|
(content/issue-kinds (doc-append (doc-empty "d") (mk-text "" "x")))
|
|
(list "id"))
|
|
(content-test
|
|
"nil id"
|
|
(content/issue-kinds
|
|
(doc-append (doc-empty "d") (blk-set (mk-text "x" "y") "id" nil)))
|
|
(list "id"))
|
|
|
|
;; ── duplicate ids ──
|
|
(define
|
|
dup
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "x" "a"))
|
|
(mk-text "x" "b")))
|
|
(content-test
|
|
"duplicate id detected"
|
|
(content/issue-kinds dup)
|
|
(list "duplicate"))
|
|
(content-test
|
|
"duplicate reported once"
|
|
(len
|
|
(filter (fn (i) (= (get i :kind) "duplicate")) (content/validate dup)))
|
|
1)
|
|
(content-test "duplicate not valid" (content/valid? dup) false)
|
|
|
|
;; ── unknown block type (raw base instance) ──
|
|
(define raw (st-iv-set! (st-make-instance "CtBlock") "id" "z"))
|
|
(content-test
|
|
"unknown type flagged"
|
|
(content/issue-kinds (doc-append (doc-empty "d") raw))
|
|
(list "type"))
|
|
|
|
;; ── issue carries id + detail ──
|
|
(define
|
|
iss
|
|
(first
|
|
(content/validate
|
|
(doc-append (doc-empty "d") (mk-text "bad" 9)))))
|
|
(content-test "issue has id" (get iss :id) "bad")
|
|
(content-test "issue has detail" (string? (get iss :detail)) true)
|
|
|
|
;; ── multiple issues across blocks accumulate ──
|
|
(define
|
|
messy
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-heading "h" "x" "ok"))
|
|
(mk-text "" 5)))
|
|
(content-test
|
|
"issues accumulate"
|
|
(> (len (content/validate messy)) 2)
|
|
true)
|
|
|
|
;; ── all block types valid when well-formed ──
|
|
(define
|
|
allgood
|
|
(doc-append
|
|
(doc-append
|
|
(doc-append
|
|
(doc-append
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-code "c" "sx" "(+ 1 2)"))
|
|
(mk-quote "q" "Ada" "to err"))
|
|
(mk-embed "e" "https://v" "vimeo"))
|
|
(mk-divider "dv"))
|
|
(mk-heading "hh" 2 "H"))
|
|
(mk-text "tt" "T")))
|
|
(content-test "all well-formed types valid" (content/valid? allgood) true)
|
|
|
|
;; ── tree-aware: descends into sections ──
|
|
(define
|
|
nested
|
|
(doc-append
|
|
(doc-empty "d")
|
|
(mk-section
|
|
"s"
|
|
(list (mk-heading "nh" 1 "H") (mk-text "np" "ok")))))
|
|
(content-test "valid nested section" (content/valid? nested) true)
|
|
|
|
(define
|
|
nested-bad
|
|
(doc-append
|
|
(doc-empty "d")
|
|
(mk-section "s" (list (mk-heading "nh" "notnum" "H")))))
|
|
(content-test
|
|
"nested bad field detected"
|
|
(content/issue-kinds nested-bad)
|
|
(list "field"))
|
|
|
|
;; valid section block itself
|
|
(content-test
|
|
"section valid"
|
|
(content/valid? (doc-append (doc-empty "d") (mk-section "s" (list))))
|
|
true)
|
|
(content-test
|
|
"section bad children"
|
|
(content/issue-kinds
|
|
(doc-append
|
|
(doc-empty "d")
|
|
(st-iv-set! (mk-section "s" (list)) "children" "nope")))
|
|
(list "field"))
|
|
|
|
;; duplicate id across a section boundary (top-level id == nested id)
|
|
(define
|
|
dup-tree
|
|
(doc-append
|
|
(doc-append (doc-empty "d") (mk-text "x" "top"))
|
|
(mk-section "s" (list (mk-text "x" "nested")))))
|
|
(content-test
|
|
"tree-wide duplicate detected"
|
|
(len
|
|
(filter
|
|
(fn (i) (= (get i :kind) "duplicate"))
|
|
(content/validate dup-tree)))
|
|
1)
|
|
(content-test "tree dup not valid" (content/valid? dup-tree) false)
|