diff options
| author | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-19 11:35:01 +0200 |
|---|---|---|
| committer | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-19 11:35:01 +0200 |
| commit | 717a6c2032d0df3669333dd52f993e8f84563bc2 (patch) | |
| tree | 7640e0b959ee944db8631a3b7d4d6188cec99007 /test/test_emit.ml | |
| parent | 18c60c3d0ad273374410dcc0118d82493f90da98 (diff) | |
| download | colitur-717a6c2032d0df3669333dd52f993e8f84563bc2.tar.gz colitur-717a6c2032d0df3669333dd52f993e8f84563bc2.zip | |
test(emit): replace two vacuous CSV/XML assertions with real ones
The live-data CSV assertion inspected only the first field's length,
always the 10-char ISO date, which can never contain a comma -- it could
not fail no matter what emit_csv.ml did with the rest of the row.
Mutation-proved: replacing emit_csv.ml's escape_field call with identity
left every test green while the real output emitted a 14-field row
against a 13-column header. Fixed by parsing the row as RFC 4180 actually
requires (a small quote-aware splitter) and asserting the field count
matches the header, plus asserting the quoted substring appears literally.
The XML suite asserted Escape.Xml's correctness in isolation but never
that emit_xml.ml actually calls it on every interpolated value. Bypassing
one escape call at the name-element site left all tests green while real
2035 output (Sts. Fabian & Sebastian, 20 January) emitted a bare '&' that
xmllint rejects. Fixed by adding a live-data test against the 2035 fixture
asserting an escaped ampersand is present and no bare one remains.
Both new assertions were run against their named mutations and confirmed
to redden before being reverted.
Diffstat (limited to 'test/test_emit.ml')
| -rw-r--r-- | test/test_emit.ml | 114 |
1 files changed, 103 insertions, 11 deletions
diff --git a/test/test_emit.ml b/test/test_emit.ml index 63bb3d0..a22eaaf 100644 --- a/test/test_emit.ml +++ b/test/test_emit.ml @@ -5,6 +5,57 @@ module Xml = Colitur_render.Emit_xml let view_2027 () = Test_view.view_of 2027 +(* Substring search shared by several live-data checks below (CSV, XML), in + place of a repeated inline recursive finder. *) +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 + +(* A byte-accurate RFC 4180 field splitter. [String.split_on_char ','] cannot + be trusted to count fields: a correctly QUOTED field is legally allowed to + contain a comma (exactly what Joseph's own name field does below), so a + naive split over-counts by the number of internal commas whether or not + they are correctly quoted -- it cannot tell the difference, which is + precisely why the test this replaced was vacuous. *) +let parse_csv_row line = + let n = String.length line in + let fields = ref [] in + let buf = Buffer.create 32 in + let i = ref 0 in + while !i < n do + if line.[!i] = '"' then begin + incr i; + let closed = ref false in + while (not !closed) && !i < n do + if line.[!i] = '"' then + if !i + 1 < n && line.[!i + 1] = '"' then begin + Buffer.add_char buf '"'; + i := !i + 2 + end + else begin + incr i; + closed := true + end + else begin + Buffer.add_char buf line.[!i]; + incr i + end + done + end + else if line.[!i] = ',' then begin + fields := Buffer.contents buf :: !fields; + Buffer.clear buf; + incr i + end + else begin + Buffer.add_char buf line.[!i]; + incr i + end + done; + fields := Buffer.contents buf :: !fields; + List.rev !fields + let test_csv_header_and_rows () = let out = Csv.year (view_2027 ()) in let lines = String.split_on_char '\n' out |> List.filter (fun l -> l <> "") in @@ -28,8 +79,17 @@ let test_csv_quotes_commas () = (fun l -> String.length l > 10 && String.sub l 0 10 = "2027-03-19") (String.split_on_char '\n' out) in - Alcotest.(check bool) "the comma in Joseph's name is quoted, not a field break" true - (String.length (String.split_on_char ',' joseph |> List.hd) = 10) + (* The check this replaced inspected the length of the FIRST field only -- + always the 10-char ISO date, which can never contain a comma, so it + could never fail. Parse the row as RFC 4180 actually requires + (quote-aware) and check the FIELD COUNT against the header: a comma + that escapes its quoting produces 14 fields, not 13. Also assert the + quoted substring appears literally, byte for byte -- belt and braces, + and closer to what a human reviewing the CSV would actually look for. *) + Alcotest.(check int) "the row has exactly 13 fields, same as the header" + 13 (List.length (parse_csv_row joseph)); + Alcotest.(check bool) "Joseph's comma-bearing name is quoted whole, not split" true + (contains ~needle:"\"St. Joseph, Spouse of the Bl. Virgin Mary\"" joseph) let test_json_parses_back () = let out = Json.year (view_2027 ()) in @@ -77,14 +137,6 @@ let suite = 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 @@ -104,8 +156,48 @@ let test_xml_escapes_data () = Alcotest.(check string) "amp" "a & b" (Xml.escape "a & b"); Alcotest.(check string) "angle" "<x>" (Xml.escape "<x>") +(* [is_entity_at s i] recognises the five predefined XML entities and a + numeric character reference starting at [s.[i]] = '&'. Anything else + starting at a '&' is a bare, illegal ampersand -- exactly what + [xmllint --noout] refuses a document over. *) +let is_entity_at s i = + let n = String.length s in + let starts_with prefix = + let pn = String.length prefix in + i + pn <= n && String.sub s i pn = prefix + in + starts_with "&" || starts_with "<" || starts_with ">" + || starts_with """ || starts_with "'" + || + (* &#NNN; -- one or more digits then ';'. *) + (i + 2 < n && s.[i + 1] = '#' + && + let j = ref (i + 2) in + while !j < n && s.[!j] >= '0' && s.[!j] <= '9' do + incr j + done; + !j > i + 2 && !j < n && s.[!j] = ';') + +(* Live-data check. [test_xml_escapes_data] above proves [Escape.Xml] is + correct in isolation; it proves nothing about whether [Emit_xml.year] + actually CALLS it on every interpolated value -- bypassing that call + while leaving [Escape.Xml] itself untouched left every test in this suite + green (mutation-proven; see the branch review that found this). Real 2035 + output carries "Sts. Fabian & Sebastian" (20 January) unescaped in the + source data, which is exactly the case that must come out as "&", and + the whole document must then contain no OTHER bare '&' anywhere. *) +let test_xml_escapes_live_data () = + let out = Xml.year (Test_view.view_of 2035) in + Alcotest.(check bool) "Fabian & Sebastian's ampersand is escaped" true + (contains ~needle:"&" out); + let bare = ref 0 in + String.iteri (fun i c -> if c = '&' && not (is_entity_at out i) then incr bare) out; + Alcotest.(check int) "no bare, unescaped '&' anywhere in the document" 0 !bare + 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 ] ) + Alcotest.test_case "escapes data" `Quick test_xml_escapes_data; + Alcotest.test_case "escapes live data (2035, Fabian & Sebastian)" `Quick + test_xml_escapes_live_data ] ) |
