diff options
Diffstat (limited to 'test/test_emit.ml')
| -rw-r--r-- | test/test_emit.ml | 203 |
1 files changed, 203 insertions, 0 deletions
diff --git a/test/test_emit.ml b/test/test_emit.ml new file mode 100644 index 0000000..a22eaaf --- /dev/null +++ b/test/test_emit.ml @@ -0,0 +1,203 @@ +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 + +(* 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 + Alcotest.(check int) "366 lines: header + 365 days" 366 (List.length lines); + Alcotest.(check string) "header" + "date,rite,season,week,slug,rank,colour,subject,name_la,name_en,first,gospel,comms" + (List.hd lines); + Alcotest.(check bool) "first row is 1 January" true + (String.length (List.nth lines 1) > 10 && String.sub (List.nth lines 1) 0 10 = "2027-01-01") + +(* RFC 4180: a field containing a comma, quote or newline is quoted, and an + embedded quote is doubled. Feast names contain commas ("St. Joseph, Spouse + of the Bl. Virgin Mary"), so this is live on real data, not hypothetical. *) +let test_csv_quotes_commas () = + Alcotest.(check string) "comma quoted" "\"a,b\"" (Csv.escape_field "a,b"); + Alcotest.(check string) "quote doubled" "\"a\"\"b\"" (Csv.escape_field "a\"b"); + Alcotest.(check string) "plain unquoted" "ab" (Csv.escape_field "ab"); + let out = Csv.year (view_2027 ()) in + let joseph = + List.find + (fun l -> String.length l > 10 && String.sub l 0 10 = "2027-03-19") + (String.split_on_char '\n' out) + in + (* 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 + Alcotest.(check bool) "starts as an object" true (out.[0] = '{'); + let count sub = + let n = String.length sub in + let rec go i acc = + if i + n > String.length out then acc + else go (i + 1) (if String.sub out i n = sub then acc + 1 else acc) + in + go 0 0 + in + Alcotest.(check bool) "has a days array" true (count "\"days\":[" >= 1); + (* Every ISO date the view produced appears in the JSON -- that is the + property under test, not a specific occurrence count. The count is NOT + 1: the view deliberately offers both artefacts at every level (view.mli) + -- the flat top-level [days], each month's own [days], and that month's + [weeks] grid cell -- so an ordinary date's "iso" field appears 3 times. + Verified against the real 2027 engine output (all 365 dates checked); + the one exception is legitimate, not a bug: 2027-04-05 appears 6 times + because the Annunciation (25 March, impeded by Holy Week) transfers to + it under RG 96/98, and its own "to" target string is the identical + literal, tripled by the same structural redundancy. *) + Alcotest.(check int) "1 January appears (flat days + month days + week grid)" 3 + (count "\"2027-01-01\""); + Alcotest.(check int) "31 December appears (flat days + month days + week grid)" 3 + (count "\"2027-12-31\"") + +let test_json_escapes () = + Alcotest.(check string) "quote" "\"a\\\"b\"" (Json.escape_string "a\"b"); + Alcotest.(check string) "backslash" "\"a\\\\b\"" (Json.escape_string "a\\b"); + Alcotest.(check string) "newline" "\"a\\nb\"" (Json.escape_string "a\nb"); + Alcotest.(check string) "tab" "\"a\\tb\"" (Json.escape_string "a\tb"); + (* Control characters below 0x20 must be \u-escaped (RFC 8259 section 7). *) + Alcotest.(check string) "control" "\"a\\u0001b\"" (Json.escape_string "a\001b") + +let test_utf8_passes_through_json () = + Alcotest.(check string) "polish" "\"\xc5\x9awi\xc4\x99tej\"" (Json.escape_string "\xc5\x9awi\xc4\x99tej") + +let suite = + ( "Emit/csv+json", + [ Alcotest.test_case "csv header and rows" `Quick test_csv_header_and_rows; + Alcotest.test_case "csv quotes commas" `Quick test_csv_quotes_commas; + 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 ] ) + +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 = "<?xml"); + Alcotest.(check bool) "root element" true + (contains ~needle:"<calendar rite=\"ef\" year=\"2027\">" 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 "<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 live data (2035, Fabian & Sebastian)" `Quick + test_xml_escapes_live_data ] ) |