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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
|
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"
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 content =
let marker = "(reference \"" in
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
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. Read all three files at test time and
re-derive the token set from them, rather than hardcoding a list, so
this keeps working when the data changes. *)
let files =
[ "../data/ef/lectionary.sexp"; "../data/ef/sanctoral.sexp"; "../data/ef/commons.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)
let suite =
( "book",
[ Alcotest.test_case "both spellings one book" `Quick test_both_spellings_are_one_book;
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 ] )
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");
("unknown book", `Quick, test_rejects_unknown_book);
("garbage", `Quick, test_rejects_garbage) ]
|
