diff options
| -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 ] ) |