diff options
Diffstat (limited to 'test/test_citation.ml')
| -rw-r--r-- | test/test_citation.ml | 457 |
1 files changed, 457 insertions, 0 deletions
diff --git a/test/test_citation.ml b/test/test_citation.ml new file mode 100644 index 0000000..133553b --- /dev/null +++ b/test/test_citation.ml @@ -0,0 +1,457 @@ +module B = Colitur_citation.Book + +let s = Alcotest.string + +let test_both_spellings_are_one_book () = + (* The books listed here arrive in more than one spelling and must + collapse onto one id. This is the whole reason the parser exists rather + than a regex. Most pairs are dotted/undotted; "Sir"/"Ecclus" and + "Apoc"/"Rev" are a modern spelling sitting inside otherwise-Vulgate + data -- see book.mli. *) + let same a b = + match B.of_token a, B.of_token b with + | Some x, Some y -> + Alcotest.(check s) (a ^ " = " ^ b) (B.to_string x) (B.to_string y) + | _ -> Alcotest.failf "%s or %s did not resolve" a b + in + same "Isa" "Isa."; + same "Matt" "Matt."; + same "1 Cor" "1 Cor."; + same "1 Pet" "1 Pet."; + same "1 Thess" "1 Thess."; + same "Eph" "Eph."; + same "3 Kgs." "3 Kings"; + same "Sir" "Ecclus"; + same "Apoc" "Rev"; + same "2 Cor" "2 Cor."; + same "Col" "Col."; + same "Wis" "Wis."; + same "2 Tim" "2 Tim."; + same "Ex" "Exod"; + same "Ezech" "Ezek"; + same "Jas" "James" + +(* The ordinal spellings resolve in the token table. NOTE: this does NOT + exercise [Parse.split_book]'s leading-digit scan -- of_token is a plain + table lookup. The parse-layer cases in [parse_suite] cover that; both are + needed, and confusing the two is how the gap survived review once already. *) +let test_ordinal_books_beyond_one () = + let id t = + match B.of_token t with + | Some x -> B.to_string x + | None -> Alcotest.failf "%s did not resolve" t + in + Alcotest.(check s) "3 Kings" "kings_3" (id "3 Kings"); + Alcotest.(check s) "3 Kgs." "kings_3" (id "3 Kgs."); + Alcotest.(check s) "4 Kings" "kings_4" (id "4 Kings") + +(* The fallback display name: what a book renders as when a language file has + no [bible] entry for it. Must be the data's own spelling, never the id -- + and must itself re-parse, or Render/Parse round-tripping breaks. *) +let test_default_spelling () = + let sp t = + match B.of_token t with + | Some x -> B.default_spelling x + | None -> Alcotest.failf "%s did not resolve" t + in + Alcotest.(check s) "luke" "Luke" (sp "Luke"); + Alcotest.(check s) "kings_3 uses first spelling" "3 Kings" (sp "3 Kgs."); + let cited = List.map snd B.tokens in + List.iter + (fun id -> + if List.mem id cited then begin + let d = B.default_spelling id in + match B.of_token d with + | Some back when B.to_string back = B.to_string id -> () + | _ -> + Alcotest.failf "default_spelling %s = %S does not resolve back" + (B.to_string id) d + end) + B.all + +let test_unknown_token_is_none () = + Alcotest.(check bool) "not a book" true (B.of_token "Nonesuch" = None) + +let test_vulgate_is_identity () = + match B.of_token "3 Kings" with + | None -> Alcotest.fail "3 Kings did not resolve" + | Some k -> + Alcotest.(check s) "unmapped" "kings_3" (B.to_string (B.map B.vulgate k)) + +let test_modern_renumbers () = + let modern = B.tradition_of_fields [ ("kings_3", "kings_1") ] in + match B.of_token "3 Kings" with + | None -> Alcotest.fail "3 Kings did not resolve" + | Some k -> + Alcotest.(check s) "renumbered" "kings_1" (B.to_string (B.map modern k)) + +let test_tokens_has_no_duplicate_spelling () = + (* [of_token] resolves via [List.assoc_opt], which silently prefers the + first match on a duplicate key. A copy-paste collision in the table + would therefore mis-map a book in total silence, never an exception -- + assert the invariant directly rather than trust it by inspection. *) + let spellings = List.map fst B.tokens in + let sorted = List.sort compare spellings in + let rec find_dup = function + | a :: (b :: _ as rest) -> if a = b then Some a else find_dup rest + | _ -> None + in + match find_dup sorted with + | None -> () + | Some dup -> Alcotest.failf "duplicate spelling in Book.tokens: %S" dup + +(* Read a whole file into a string. Test-only I/O; the library itself never + touches the filesystem. *) +let read_file path = + let ic = open_in_bin path in + let n = in_channel_length ic in + let content = really_input_string ic n in + close_in ic; + content + +let starts_with_at content pos prefix = + let plen = String.length prefix in + pos + plen <= String.length content && String.sub content pos plen = prefix + +(* Every [(reference ...)] payload in a data file, in file order. No + [Str]/regex -- a plain forward scan for the marker, then read to the + closing quote. Mirrors the coordinator's own survey command (grep -oh + over the reference marker, quote-delimited). *) +let references_with marker content = + let mlen = String.length marker in + let len = String.length content in + let rec loop pos acc = + if pos >= len then List.rev acc + else if starts_with_at content pos marker then + let start = pos + mlen in + match String.index_from_opt content start '"' with + | None -> List.rev acc + | Some close -> + let payload = String.sub content start (close - start) in + loop (close + 1) (payload :: acc) + else loop (pos + 1) acc + in + loop 0 [] + +let is_alpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z') +let is_one_to_four c = c >= '1' && c <= '4' + +(* The leading book token of one reference payload, e.g. ["2 Tim 4:1-8"] -> + ["2 Tim"], ["Wis. 5:1-5"] -> ["Wis."]. Mirrors the coordinator's own + survey command's second stage: + `sed -E 's/^(([1-4] )?[A-Za-z]+\.?).*/\1/'`. *) +let book_token r = + let len = String.length r in + let start = if len >= 2 && is_one_to_four r.[0] && r.[1] = ' ' then 2 else 0 in + let i = ref start in + while !i < len && is_alpha r.[!i] do + incr i + done; + let stop = if !i < len && r.[!i] = '.' then !i + 1 else !i in + String.sub r 0 stop + +(* A citation is written TWO ways in this project's data, and a survey that + knows only one of them silently under-reads the corpus: + (reference "Isa 60:1-6") -- lectionary/sanctoral/commons + (Set_citation First "Wis 7:7-14") -- adjustments.sexp, an overlay + Both markers are scanned below. *) +let references content = + (* Each marker must include the OPENING QUOTE. [references_with] returns + the text between the marker and the next '"', so a marker stopping at + "(Set_citation " yields "First " / "Gospel " -- the part label, never + the citation -- and every entry is then silently discarded. That was + this function's first version, and it read the file while extracting + nothing at all. *) + references_with "(reference \"" content + @ references_with "(Set_citation First \"" content + @ references_with "(Set_citation Gospel \"" content + +let test_every_data_file_token_resolves () = + (* The check whose absence caused fix round 1: the brief surveyed only + the lectionary and missed 21 tokens, several common, living in + sanctoral.sexp and commons.sexp. + + adjustments.sexp was then missed AGAIN, by this very test, because it + writes citations as `Set_citation` rather than `(reference ...)` -- the + same "one file too few" shape twice over. All FOUR shipped files are + read here, and the token set is re-derived from them at test time + rather than hardcoded, so this keeps working when the data changes. *) + let files = + [ "../data/ef/lectionary.sexp"; "../data/ef/sanctoral.sexp"; + "../data/ef/commons.sexp"; "../data/ef/adjustments.sexp" ] + in + let tokens = + files + |> List.concat_map (fun f -> references (read_file f)) + |> List.map book_token + |> List.sort_uniq compare + in + Alcotest.(check bool) "at least one token found" true (List.length tokens > 0); + let unresolved = List.filter (fun t -> B.of_token t = None) tokens in + match unresolved with + | [] -> () + | _ -> + Alcotest.failf "unresolved book tokens in shipped data: %s" + (String.concat ", " unresolved) + +(* lang/traditions.ini's own [modern] section, duplicated here on purpose: + the shipped file and this expectation are written twice and must agree, + so a typo in either is visible. Two ids mapping onto the SAME target is + always a typo -- it would silently merge two books -- so this asserts the + mapping is injective, not merely that every id is known. *) +let test_modern_tradition_is_injective () = + (* READ the shipped file. An earlier version of this test hand-copied the + table, which asserted things about the copy and nothing at all about the + artifact -- a mapping added to traditions.ini and forgotten here would + have passed. *) + let text = + let ic = open_in_bin "../lang/traditions.ini" in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; s + in + let sections = + match Colitur_kernel.Overlay_ini.parse_sections text with + | Ok ss -> ss + | Error e -> Alcotest.failf "lang/traditions.ini: %s" e + in + let section name = + List.filter_map + (fun (sc : Colitur_kernel.Overlay_ini.section) -> + if sc.Colitur_kernel.Overlay_ini.name = name then + Some sc.Colitur_kernel.Overlay_ini.fields + else None) + sections + |> List.concat + in + (* [vulgate] must be the identity: an entry there would silently renumber + the DEFAULT, which is the one thing this design promises never happens. *) + Alcotest.(check (list (pair string string))) "vulgate is identity" [] + (section "vulgate"); + let fields = section "modern" in + Alcotest.(check bool) "modern is not empty" true (fields <> []); + Alcotest.(check (list string)) "all ids known" [] (B.unknown_fields fields); + (* every declared tradition target is actually reachable -- an unused target + is either a forgotten mapping or dead weight *) + let targets = List.map snd fields in + (* [B.tokens] is (spelling, id) pairs, so membership of an ID is a lookup + over the VALUES, not [mem_assoc] over the keys. Getting that backwards + flags every ordinary book as an unused target. *) + let cited = List.map (fun (_, i) -> B.to_string i) B.tokens in + List.iter + (fun id -> + let n = B.to_string id in + if (not (List.mem n cited)) && not (List.mem n targets) then + Alcotest.failf "%s is a declared target no tradition maps onto" n) + B.all; + let uniq = List.sort_uniq compare targets in + Alcotest.(check int) "no two ids share a target" + (List.length targets) (List.length uniq) + +let suite = + ( "book", + [ Alcotest.test_case "both spellings one book" `Quick test_both_spellings_are_one_book; + Alcotest.test_case "ordinal books 3 and 4" `Quick test_ordinal_books_beyond_one; + Alcotest.test_case "default spelling round-trips" `Quick test_default_spelling; + Alcotest.test_case "unknown token" `Quick test_unknown_token_is_none; + Alcotest.test_case "vulgate identity" `Quick test_vulgate_is_identity; + Alcotest.test_case "modern renumbers" `Quick test_modern_renumbers; + Alcotest.test_case "tokens has no duplicate spelling" `Quick + test_tokens_has_no_duplicate_spelling; + Alcotest.test_case "every data file token resolves" `Quick + test_every_data_file_token_resolves; + Alcotest.test_case "modern tradition is injective" `Quick + test_modern_tradition_is_injective ] ) + +module P = Colitur_citation.Parse + +(* Render a parse back to a debug string so a test can assert shape + compactly: "book|chapter:v-v,v-v|chapter:v". *) +let show (t : P.t) = + let range (r : P.verse_range) = + match r.P.last with + | None -> string_of_int r.P.first + | Some l -> Printf.sprintf "%d-%d" r.P.first l + in + let part (p : P.part) = + Printf.sprintf "%d:%s" p.P.chapter + (String.concat "," (List.map range p.P.verses)) + in + B.to_string t.P.book ^ "|" ^ String.concat "|" (List.map part t.P.parts) + +let parses input expected () = + match P.parse input with + | Error e -> Alcotest.failf "%s did not parse: %s" input e + | Ok t -> Alcotest.(check s) input expected (show t) + +let test_rejects_unknown_book () = + Alcotest.(check bool) "error" true (Result.is_error (P.parse "Nonesuch 1:1")) + +let test_rejects_garbage () = + List.iter + (fun bad -> + Alcotest.(check bool) bad true (Result.is_error (P.parse bad))) + [ ""; "Luke"; "Luke :"; "Luke 1:"; "Luke abc:1" ] + +let parse_suite = + [ ("simple", `Quick, parses "1 Cor 11:20-32" "corinthians_1|11:20-32"); + ("trailing period", `Quick, parses "1 John 3:13-18." "john_1|3:13-18"); + ("single verse", `Quick, parses "Luke 2:21" "luke|2:21"); + ("dotted spelling", `Quick, parses "Isa. 1:16-19" "isaiah|1:16-19"); + ("verse list", `Quick, parses "Acts 10:34, 42-48" "acts|10:34,42-48"); + ("new chapter", `Quick, parses "1 Cor. 9:24-27; 10:1-5" + "corinthians_1|9:24-27|10:1-5"); + (* Rule 1: the second part names no chapter, so it inherits chapter 2. *) + ("inherited chapter", `Quick, parses "Joel 2:23-24; 26-27" "joel|2:23-24|2:26-27"); + (* Rule 2: comma separates chapter from verses in the second part. *) + ("comma chapter", `Quick, parses "Mark 14:32-72; 15, 1-46" + "mark|14:32-72|15:1-46"); + ("four ranges", `Quick, parses "Dan 13:1-9, 15-17, 19-30, 33-62." + "daniel|13:1-9,15-17,19-30,33-62"); + ("mixed", `Quick, parses "Num 20:1, 3; 6-13." "numbers|20:1,3|20:6-13"); + ("trailing semicolon", `Quick, parses "1 Cor 1:18-25; 1:30;" + "corinthians_1|1:18-25|1:30"); + ("four parts", `Quick, parses "Eccli 24:5; 14:7; 14:9-11; 24:30-31" + "ecclesiasticus|24:5|14:7|14:9-11|24:30-31"); + ("modern name, vulgate id", `Quick, parses "Rev 12:1" "apocalypse|12:1"); + (* Ordinals 3 and 4 must survive [split_book]'s leading-digit scan. + Narrowing its '1'..'4' range to '1'..'3' passes every OTHER case in + this suite silently, while seven real citations depend on it. A + Book.of_token test does NOT cover this -- that is a table lookup and + never reaches split_book. *) + ("ordinal 3 parses", `Quick, parses "3 Kings 17:8-16" "kings_3|17:8-16"); + ("ordinal 3 dotted", `Quick, parses "3 Kgs. 19:3-8" "kings_3|19:3-8"); + ("ordinal 4 parses", `Quick, parses "4 Kings 5:1-15" "kings_4|5:1-15"); + ("unknown book", `Quick, test_rejects_unknown_book); + ("garbage", `Quick, test_rejects_garbage) ] + +module R = Colitur_citation.Render + +let names id form = + let n = B.to_string id in + match form with `Abbr -> (if n = "luke" then "Luc." else n) + | `Full -> (if n = "luke" then "Evangelium secundum Lucam" else n) + +let render_with fields input expected () = + let style = R.style_of_fields fields in + match P.parse input with + | Error e -> Alcotest.failf "%s did not parse: %s" input e + | Ok t -> Alcotest.(check s) input expected (R.render style ~names t) + +let test_unquotes_trailing_space () = + let st = R.style_of_fields [ ("part_sep", "\"; \"") ] in + Alcotest.(check s) "quotes stripped, space kept" "; " (R.part_sep st) + +let test_bare_value_untouched () = + let st = R.style_of_fields [ ("range", "{first}-{last}") ] in + Alcotest.(check s) "no quotes" "{first}-{last}" (R.range st) + +(* [subst] has no test pressure of its own anywhere else in the suite, so + these three isolate its contract directly through the only surface that + calls it: a [range]/[chapter_verse] template chosen so nothing else in + the pipeline (verse-list joining, book naming) can mask the result. *) +let test_subst_no_placeholder () = + (* A template with no "{" at all passes through completely unchanged. *) + render_with [ ("book", "abbr"); ("chapter_verse", "fixed-text") ] "Luke 2:21" + "Luc. fixed-text" () + +let test_subst_two_placeholders () = + (* Two DIFFERENT known placeholders, reordered relative to the record's + own field order ([last] before [first]) -- proves substitution is by + name, not by position. *) + render_with + [ ("book", "abbr"); ("range", "{last}~{first}") ] + "Luke 5:12-14" "Luc. 5:14~12" () + +let test_subst_unknown_placeholder_alone () = + (* A template that is NOTHING but an unrecognised placeholder: it must + survive byte-for-byte, proving [subst] never touches an unmatched + "{...}" run even when there is no surrounding literal text to anchor + on. *) + render_with [ ("book", "abbr"); ("range", "{nope}") ] "Luke 5:12-14" + "Luc. 5:{nope}" () + +(* [roman_numeral] is private to Render (not in the .mli, matching + [View.roman_numeral]'s own precedent -- tested indirectly, never + exposed). Reached through [render] with a [chapter_verse] template of + bare [{chapter_roman}], [book_sep] emptied and [names] returning "", so + the assertion isolates exactly the numeral and nothing else. *) +let roman_of n = + let luke = match B.of_token "Luke" with Some id -> id | None -> assert false in + let t : P.t = { P.book = luke; parts = [ { P.chapter = n; verses = [ { P.first = 1; last = None } ] } ] } in + let style = R.style_of_fields [ ("book_sep", ""); ("chapter_verse", "{chapter_roman}") ] in + R.render style ~names:(fun _ _ -> "") t + +let test_roman_numeral_values () = + List.iter + (fun (n, expected) -> Alcotest.(check s) (string_of_int n) expected (roman_of n)) + [ (1, "I"); (4, "IV"); (9, "IX"); (14, "XIV"); (40, "XL"); (150, "CL") ] + +let test_roman_numeral_non_positive () = + (* The one input that could loop forever in a naive implementation: a + non-positive chapter returns the arabic form instead. Completing at + all is part of what this test proves. *) + Alcotest.(check s) "zero" "0" (roman_of 0); + Alcotest.(check s) "negative" "-3" (roman_of (-3)) + +let render_suite = + ( "Citation/render", + [ Alcotest.test_case "latin default" `Quick + (render_with [ ("book", "abbr") ] "Luke 5:12-14" "Luc. 5:12-14"); + Alcotest.test_case "full name" `Quick + (render_with [ ("book", "full") ] "Luke 5:12-14" + "Evangelium secundum Lucam 5:12-14"); + Alcotest.test_case "comma style" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}, {verses}") ] + "Luke 5:12-14" "Luc. 5, 12-14"); + Alcotest.test_case "multi part" `Quick + (render_with [ ("book", "abbr"); ("part_sep", "\"; \"") ] + "Joel 2:23-24; 26-27" "joel 2:23-24; 2:26-27"); + Alcotest.test_case "unquote" `Quick test_unquotes_trailing_space; + Alcotest.test_case "bare value" `Quick test_bare_value_untouched; + (* The Missal's own convention, scan-verified: "Matth. 11, 2" / + "Ioann. 1, 1" -- dotted abbreviation, comma, ARABIC chapter. *) + Alcotest.test_case "missal convention" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}, {verses}") ] + "Luke 5:12-14" "Luc. 5, 12-14"); + Alcotest.test_case "roman chapter" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter_roman}, {verses}") ] + "Luke 5:12-14" "Luc. V, 12-14"); + (* U+00A0 between book and reference, for typeset output. *) + Alcotest.test_case "nbsp book sep" `Quick + (render_with [ ("book", "abbr"); ("book_sep", "\"\xc2\xa0\"") ] + "Luke 5:12-14" "Luc.\xc2\xa05:12-14"); + Alcotest.test_case "unknown placeholder survives" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}:{nope}") ] + "Luke 5:12-14" "Luc. 5:{nope}"); + Alcotest.test_case "subst: no placeholder" `Quick test_subst_no_placeholder; + Alcotest.test_case "subst: two placeholders" `Quick test_subst_two_placeholders; + Alcotest.test_case "subst: unknown placeholder alone" `Quick + test_subst_unknown_placeholder_alone; + Alcotest.test_case "roman_numeral: table values" `Quick test_roman_numeral_values; + Alcotest.test_case "roman_numeral: non-positive" `Quick + test_roman_numeral_non_positive ] ) + +module S = Colitur_citation.Sigla + +let test_verbatim_is_identity () = + List.iter + (fun c -> Alcotest.(check s) c c (S.format S.verbatim c)) + [ "3 Kgs. 19:3-8"; "Isa. 1:16-19"; "not a citation at all" ] + +let test_unparseable_survives_unchanged () = + let sg = S.make ~style:R.default_style ~tradition:B.vulgate ~names in + Alcotest.(check s) "passed through" "Nonesuch 1:1" (S.format sg "Nonesuch 1:1") + +let test_tradition_applies () = + let modern = B.tradition_of_fields [ ("kings_3", "kings_1") ] in + let sg = S.make ~style:R.default_style ~tradition:modern ~names in + Alcotest.(check s) "renumbered" "kings_1 19:3-8" (S.format sg "3 Kings 19:3-8") + +let sigla_suite = + [ ("verbatim identity", `Quick, test_verbatim_is_identity); + ("unparseable survives", `Quick, test_unparseable_survives_unchanged); + ("tradition applies", `Quick, test_tradition_applies) ] |