1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
(* SPDX-License-Identifier: AGPL-3.0-or-later *)
(* Every citation the engine can emit must parse. This is the check that
would have caught the seven duplicate book spellings -- nothing validated
them before.
Same shape as test_lang_coverage.ml, which this file deliberately mirrors:
a miss there is a slug with no name, a miss here is a citation the parser
cannot read.
The walk below also drives the round-trip check (Sigla facade, Task 5):
ONE pass over 1970-2070 collects into TWO tables, [bad_parse] and
[bad_round_trip], rather than walking the whole range twice for two
independent Alcotest cases -- measured, a second walk would cost ~1.5s of
a 5.65s fast suite for zero extra coverage. *)
module P = Colitur_citation.Parse
let bad_parse : (string, string) Hashtbl.t = Hashtbl.create 64
let bad_round_trip : (string, string) Hashtbl.t = Hashtbl.create 16
let walked = ref false
(* Parse -> render -> parse must reach the same structure.
NOTE the [names] function: [Book.default_spelling], NOT [Book.to_string].
[to_string] returns the internal id ("corinthians_1"), which is not a
registered token, so rendering with it produces something Parse cannot
read back -- 0 of 738 round-trip. Measured during Task 4; do not
"simplify" this back to to_string. A renderer that emits an unparseable
string, or a style whose own output it cannot read, fails here. Compares
STRUCTURE, not text: the rendered form legitimately differs from the
input (a normalised book spelling, a dropped trailing period), and
asserting text equality would just pin those differences. *)
let sg =
Colitur_citation.Sigla.make ~style:Colitur_citation.Render.default_style
~tradition:Colitur_citation.Book.vulgate
~names:(fun id _form -> Colitur_citation.Book.default_spelling id)
let walk () =
if not !walked then begin
walked := true;
let layer =
match Test_support.load_ef_layer () with
| Ok l -> l
| Error e -> Alcotest.failf "%s" e
in
let ctx = Test_support.ef_context () in
for y = 1970 to 2070 do
Array.iter
(fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) ->
List.iter
(fun (c : Colitur_kernel.Citation.t) ->
let r = c.Colitur_kernel.Citation.reference in
match P.parse r with
| Error e -> if not (Hashtbl.mem bad_parse r) then Hashtbl.add bad_parse r e
| Ok first ->
let rendered = Colitur_citation.Sigla.format sg r in
(match P.parse rendered with
| Error e ->
Hashtbl.replace bad_round_trip r ("re-parse failed: " ^ e)
| Ok again ->
if again <> first then
Hashtbl.replace bad_round_trip r ("structure changed: " ^ rendered)))
d.Colitur_kernel.Liturgical_day.citations)
(Colitur_kernel.Calendar.year ctx layer y)
done
end
let test_every_citation_parses () =
walk ();
if Hashtbl.length bad_parse > 0 then begin
Hashtbl.iter (fun r e -> Printf.eprintf "UNPARSED %S: %s\n" r e) bad_parse;
Alcotest.failf "%d citation(s) did not parse" (Hashtbl.length bad_parse)
end
let test_round_trip () =
walk ();
if Hashtbl.length bad_round_trip > 0 then begin
Hashtbl.iter (fun r e -> Printf.eprintf "ROUND-TRIP %S: %s\n" r e) bad_round_trip;
Alcotest.failf "%d citation(s) failed round-trip" (Hashtbl.length bad_round_trip)
end
(* This project has ONE test executable. Every test_<module>.ml exposes a
[suite] value and test_colitur.ml aggregates them -- do NOT call
Alcotest.run here. Marked `Slow like test_lang_coverage's own year walk. *)
let suite =
( "citation-coverage",
[ Alcotest.test_case "every citation parses" `Slow test_every_citation_parses;
Alcotest.test_case "sigla round-trip" `Slow test_round_trip ] )
|
