From 544836cf0f6373a0a753d0953ce7e60fd96337af Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:57:42 +0200 Subject: feat(render): XML emitter and schema Element-per-field; attributes carry identity only and there is no mixed content, so a consumer's XPath never has to distinguish the two. Schema validation is an opt-in make check-schema via xmllint, not an in-suite assertion: validating XSD needs an XML library and the dependency list is frozen. It prints SKIPPED loudly when xmllint is absent, because a silent skip reads as a pass. The suite asserts well-formedness properties directly instead. This corrects the design spec, which claimed in-test validation. --- test/test_colitur.ml | 3 ++- test/test_emit.ml | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 36 insertions(+), 1 deletion(-) (limited to 'test') diff --git a/test/test_colitur.ml b/test/test_colitur.ml index b61eed6..ca61415 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -11,4 +11,5 @@ let () = Test_template.suite; Test_template.render_suite; Test_view.suite; - Test_emit.suite ] + Test_emit.suite; + Test_emit.xml_suite ] diff --git a/test/test_emit.ml b/test/test_emit.ml index a8fd45c..63bb3d0 100644 --- a/test/test_emit.ml +++ b/test/test_emit.ml @@ -1,6 +1,7 @@ module V = Colitur_render.View module Csv = Colitur_render.Emit_csv module Json = Colitur_render.Emit_json +module Xml = Colitur_render.Emit_xml let view_2027 () = Test_view.view_of 2027 @@ -75,3 +76,36 @@ let suite = Alcotest.test_case "json parses back" `Quick test_json_parses_back; Alcotest.test_case "json escapes" `Quick test_json_escapes; Alcotest.test_case "json passes utf8 through" `Quick test_utf8_passes_through_json ] ) + +(* Substring search shared by the two XML well-formedness checks below, in + place of the brief's inline recursive finder -- same property, clearer to + read. *) +let contains ~needle hay = + let n = String.length needle and h = String.length hay in + let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in + go 0 + +let test_xml_shape () = + let out = Xml.year (view_2027 ()) in + Alcotest.(check bool) "declaration" true + (String.length out > 5 && String.sub out 0 5 = "" out) + +(* Every '<' in the output must open a tag: an unescaped '<' inside a feast + name is the failure that makes a whole feed unparseable. *) +let test_xml_tags_balance () = + let out = Xml.year (view_2027 ()) in + let opens = ref 0 and closes = ref 0 in + String.iter (fun c -> if c = '<' then incr opens else if c = '>' then incr closes) out; + Alcotest.(check int) "every < has a >" !opens !closes + +let test_xml_escapes_data () = + Alcotest.(check string) "amp" "a & b" (Xml.escape "a & b"); + Alcotest.(check string) "angle" "<x>" (Xml.escape "") + +let xml_suite = + ( "Emit/xml", + [ Alcotest.test_case "shape" `Quick test_xml_shape; + Alcotest.test_case "tags balance" `Quick test_xml_tags_balance; + Alcotest.test_case "escapes data" `Quick test_xml_escapes_data ] ) -- cgit v1.3