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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
|
(* Task 6 (2026-08-21-colitur-celebrant-rubrics-phase1): validation layer 6
-- the Latin Mass Society's own printed Ordo for England & Wales
(test/fixtures/lms-ordo-2024-2025.sexp; that file's own provenance
header carries the full source citation, SHA-256 and the
characterisation record demanded before trusting a single row of it).
WHY THIS LAYER EXISTS, AND WHAT IT IS INDEPENDENT OF: layers 3-4
(test_differential.ml, test_oracle.ml) are ONE LINEAGE running Divinum
Officium -> missalemeum -> lectio -> colitur (CLAUDE.md's "know what
each layer cannot see" section); layer 5 (test_golden.ml) pins colitur's
own output against itself. This Ordo is compiled independently by the
Latin Mass Society (a printed book, ISBN 9781739209636, England & Wales
diocesan propers) from the 1962 Missal/1960 rubrics directly -- it never
passed through Divinum Officium, missalemeum or lectio at any point, so
an error inherited by that whole lineage (colitur's own bootstrap
included) is visible here for the first time.
SCOPE, decided after running the comparison against real data (not
guessed in advance -- see the fixture's own CHARACTERISATION section
and task-6-report.md for the measurements this scoping rests on):
- The CREED (RG 475-476, {!Rite_ef.Rubrics_ef.creed}): compared on
every day, full 1:1. One genuine day is EXCLUDED, not silently
skipped: 2025-04-18 (Good Friday) has no Mass in the 1955-restored
Holy Week, so the Ordo prints no Gl/Cr line at all -- [test_
creed_coverage] asserts this is the ONLY such day, so a future
parsing regression that swallowed a real row would fail loudly
here, not slip into "explained" silently.
- The BVM-SATURDAY SEASONAL SELECTION (RG 309(a), "iuxta temporum
diversitatem", {!Rite_ef.Lectionary_ef.bvm_saturday_citations}):
the coordinator addendum's own "sharper check" -- the Ordo's own
roman numeral (I-V) names WHICH of the five seasonal "Missae de
sancta Maria in sabbato" is said, so it validates colitur's
SEASONAL SELECTION, not merely that some BVM Mass was chosen.
Built, because the extraction supports it (whole-line anchored
match against all five, see the fixture header on why substring
matching is wrong): every {!Colitur_kernel.Mass_formulary.Votive}
day inside the fixture's own 2024-11-27..2025-12-31 window is
checked against the numeral's implied season.
- The FORMULARY OVERRIDE (does the day say its own Mass, or a
borrowed one) -- compared for THREE of {!Colitur_kernel.
Mass_formulary.source}'s five constructors, each independently
100% clean against the real fixture:
[Proper] (179 of 400 days): the Ordo shows NO "Mass of ..." line.
[Preceding_sunday] (66 of 400): the Ordo ALWAYS shows one.
[Common] (2 of 400): the Ordo shows NO "Mass of ..." line either
-- a Common-routed saint (ubaldus, didacus) still keeps his OWN
title in the Ordo, borrowing only the Common's PREFACE ("Common
Pr" on the title line itself), never a separate override line.
[Votive] is covered by the BVM check above instead (its own
override line IS the roman-numeral line).
[Own_slug] (139 of 400) is DELIBERATELY EXCLUDED from this axis,
not silently -- a real, evidenced data-representation fact, not a
guess: 11 of its 139 days DO show a "Mass of ..." override
("2nd Sunday of Advent", "the Epiphany", "1st Sunday after
Pentecost"), because data/ef/lectionary.sexp carries some ferial
slugs (e.g. [ef-advent-2-monday]) as an EXPLICIT entry whose
citations are byte-identical to the following Sunday's own
([ef-advent-sunday-2]: both "Rom 15:4-13" / "Matt 11:2-10" --
checked directly against the shipped data), rather than resolving
through the {!Colitur_kernel.Mass_formulary.Preceding_sunday}
fallback path. Both representations name the SAME texts -- this is
a provenance-field ambiguity in colitur's own data, not a rubric
question the Ordo could adjudicate either way, so asserting on it
would manufacture exactly the kind of false divergence the
coordinator addendum's "collapsed to ~0 real ones" warning is
about. Recorded here rather than dropped silently, per the task
brief's own instruction for exactly this situation.
GLORIA is extracted into the fixture (a genuine, independently useful
field for the still-unbuilt Phase 2 Gloria rule) but NOT compared here:
colitur has no {!Rite_ef.Rubrics_ef}-level Gloria predicate yet (the
design doc defers it explicitly), so there is nothing on colitur's own
side to compare it against. Comparing it would be comparing the Ordo
against nothing.
DIOCESAN SCOPE: colitur computes the UNIVERSAL General Roman Calendar
only (no diocesan overlay loaded by the differential/oracle harnesses
anywhere in this suite) -- the Ordo is an England & Wales diocesan
Ordo, and 156 of its 400 days (39%) carry at least one diocesan
variant. Every comparison in this file reads ONLY the fixture's own
universal-block fields ([formulary_override], [bvm_numeral], [gloria],
[creed] are all derived from the text BEFORE the first diocese-list
line -- see extract_lms_ordo.ml's own [scan_block]); the diocesan text
itself is never read at all, only its PRESENCE is recorded
([has_diocesan_variant]), so no diocesan variant can leak into a
comparison here by construction, not merely by care. *)
module Cal = Colitur_kernel.Calendar
module Layer = Colitur_kernel.Layer
module Overlay = Colitur_kernel.Overlay
module LD = Colitur_kernel.Liturgical_day
module Date = Colitur_kernel.Date
module MF = Colitur_kernel.Mass_formulary
module V = Rite_ef.Vocab_ef
module TE = Rite_ef.Temporal_ef
let sanctoral_path = "../data/ef/sanctoral.sexp"
let adjustments_path = "../data/ef/adjustments.sexp"
let fixture_path = "fixtures/lms-ordo-2024-2025.sexp"
let allow_list_path = "../data/ef/expected-divergences-lms.sexp"
(* Asserted, not merely documented -- test_oracle.ml's own [fixture_sha256]
comment explains why: a hand-edit or partial re-extraction would
otherwise silently turn the oracle into an unlabelled snapshot of
whatever someone last ran. Matches the fixture's own provenance header. *)
let fixture_sha256 = "da817b75c5bf40ed3be1d5f6890b199705e02ce4d42111253ab8547bccabc3f7"
(* Duplicated, not shared, from test_oracle.ml/test_differential.ml's own
identical function -- neither file exposes an .mli the other could
depend on, and this is three lines (test_oracle.ml's own comment). *)
let sha256_of_file path =
let tmp = Filename.temp_file "colitur_lms_ordo_sha256" ".txt" in
Fun.protect
~finally:(fun () -> try Sys.remove tmp with Sys_error _ -> ())
(fun () ->
let cmd = Printf.sprintf "sha256sum %s > %s" (Filename.quote path) (Filename.quote tmp) in
let rc = Sys.command cmd in
if rc <> 0 then Alcotest.failf "sha256sum exited %d for %s (is it on PATH?)" rc path;
let ic = open_in tmp in
let line =
try input_line ic
with End_of_file ->
close_in ic;
Alcotest.failf "sha256sum produced no output for %s" path
in
close_in ic;
match String.index_opt line ' ' with
| Some i -> String.sub line 0 i
| None -> Alcotest.failf "unexpected sha256sum output for %s: %S" path line)
let real_layer () =
let layer =
match Layer.load V.rank_of_sexp sanctoral_path with
| Ok l -> l
| Error e -> Alcotest.failf "%s: failed to load: %s" sanctoral_path e
in
let overlay =
match Overlay.load V.rank_of_sexp adjustments_path with
| Ok o -> o
| Error e -> Alcotest.failf "%s: failed to load: %s" adjustments_path e
in
let layer, diagnostics = Overlay.apply layer overlay in
Alcotest.(check (list string)) "the committed overlay applies cleanly, no diagnostics" []
(List.map Overlay.diagnostic_to_string diagnostics);
layer
let real_lectionary () =
match Colitur_kernel.Lectionary.load "../data/ef/lectionary.sexp" with
| Ok l -> l
| Error e -> Alcotest.failf "../data/ef/lectionary.sexp: failed to load: %s" e
let real_commons () =
match Rite_ef.Lectionary_ef.Commons.load "../data/ef/commons.sexp" with
| Ok c -> c
| Error e -> Alcotest.failf "../data/ef/commons.sexp: failed to load: %s" e
(* ---------------------------------------------------------------------- *)
(* The Ordo side: the sexp row, mirrored (not shared -- see this file's *)
(* own header) from tools/extract_lms_ordo.ml's own [row]. *)
(* ---------------------------------------------------------------------- *)
open Sexplib0.Sexp_conv
type ordo_row = {
date : string;
weekday : string;
title : string;
formulary_override : string option;
bvm_numeral : string option;
gloria : bool option;
creed : bool option;
has_diocesan_variant : bool;
}
[@@deriving sexp]
let ordo_rows () =
let sexp =
try Sexplib.Sexp.load_sexp fixture_path
with e -> Alcotest.failf "%s: failed to load: %s" fixture_path (Printexc.to_string e)
in
list_of_sexp ordo_row_of_sexp sexp
(* The fixture's own real window -- 2024-11-27 ("End of November 2024")
through 2025-12-31 (the day before the extractor's own stop marker).
400 = 4 (27-30 Nov 2024) + 31 (Dec 2024) + 365 (2025, not a leap year). *)
let window_first = "2024-11-27"
let window_last = "2025-12-31"
(* ---------------------------------------------------------------------- *)
(* The colitur side, over the same window. Mirrors test_oracle.ml's own *)
(* [colitur_rows]: the resolution walk starts a year EARLY because a *)
(* liturgical year is Advent-anchored and straddles two civil years. *)
(* ---------------------------------------------------------------------- *)
type colitur_row = {
c_date : string;
c_season : V.season;
c_formulary : MF.t option;
c_creed : bool;
}
let colitur_rows () =
let layer = real_layer () in
let rite = Rite_ef.context ~lectionary:(real_lectionary ()) ~commons:(real_commons ()) in
let by_rata : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 800 in
for y = 2023 to 2025 do
let days = Cal.year rite layer y in
Array.iter (fun (d : (V.season, V.rank) LD.t) -> Hashtbl.replace by_rata (Date.to_rata d.LD.date) d) days
done;
let mk y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e in
let rows = ref [] in
let d = ref (mk 2024 11 27) in
let stop = mk 2025 12 31 in
while Date.compare !d stop <= 0 do
(match Hashtbl.find_opt by_rata (Date.to_rata !d) with
| Some day ->
rows :=
{ c_date = Date.to_iso8601 day.LD.date; c_season = day.LD.temporal.Colitur_kernel.Temporal.season;
c_formulary = day.LD.formulary; c_creed = day.LD.creed }
:: !rows
| None -> Alcotest.failf "no colitur day resolved for %s" (Date.to_iso8601 !d));
d := Date.add_days !d 1
done;
List.rev !rows
(* ---------------------------------------------------------------------- *)
(* RG 309(a), "iuxta temporum diversitatem" -- INDEPENDENTLY re-derived *)
(* from the rubric, not called from Lectionary_ef.bvm_saturday_citations *)
(* (private to that .ml, no .mli export, and re-deriving here is itself *)
(* the more useful check: importing colitur's own function would make *)
(* this axis tautological). Mirrors that function's own season match *)
(* exactly -- see its citation in lectionary_ef.ml for the scan lines. *)
(* ---------------------------------------------------------------------- *)
let expected_bvm_numeral season ~month ~day =
match (season : V.season) with
| V.Advent -> "I"
| V.Christmastide -> "II"
| V.Time_after_epiphany when month = 1 || (month = 2 && day <= 2) -> "II"
| V.Time_after_epiphany | V.Septuagesima | V.Lent | V.Passiontide -> "III"
| V.Paschaltide -> "IV"
| V.Time_after_pentecost -> "V"
(* ---------------------------------------------------------------------- *)
(* data/ef/expected-divergences-lms.sexp -- same shape as *)
(* test_oracle.ml's own [allow_entry]/[load_allow_list]. *)
(* ---------------------------------------------------------------------- *)
type allow_entry = { id : string; citation : string; verdict : string; note : string; expected_rows : int }
[@@deriving sexp]
let load_allow_list () =
let sexps =
try Sexplib.Sexp.load_sexps allow_list_path
with e -> Alcotest.failf "%s: failed to load: %s" allow_list_path (Printexc.to_string e)
in
List.map allow_entry_of_sexp sexps
(* ---------------------------------------------------------------------- *)
(* Tests *)
(* ---------------------------------------------------------------------- *)
let test_fixture_checksum () =
Alcotest.(check string) "fixture SHA-256 matches its provenance note" fixture_sha256
(sha256_of_file fixture_path)
let test_dates_align () =
let ordo = ordo_rows () in
let colitur = colitur_rows () in
Alcotest.(check int) "the Ordo fixture has 400 rows (2024-11-27..2025-12-31)" 400 (List.length ordo);
Alcotest.(check int) "colitur resolved the same number of days" (List.length ordo) (List.length colitur);
(match ordo with o :: _ -> Alcotest.(check string) "first date" window_first o.date | [] -> Alcotest.fail "empty");
(match List.rev ordo with
| o :: _ -> Alcotest.(check string) "last date" window_last o.date
| [] -> Alcotest.fail "empty");
let mismatched =
List.filter_map
(fun (o, c) -> if String.equal o.date c.c_date then None else Some (o.date, c.c_date))
(List.combine ordo colitur)
in
Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched
(* Good Friday (2025-04-18) has no Mass at all in the 1955-restored Holy
Week -- the Ordo prints no Gl/Cr line, confirmed directly against the
source (extract_lms_ordo's own row for that date, and the raw pdftotext
text: "The Solemn Liturgical Action is celebrated in the afternoon...",
no "Gl"/"Cr" token anywhere in the block). Asserted as the ONLY such
day, not merely observed once: a future parsing regression that
swallowed a real Gl/Cr line would otherwise silently join this
"not applicable" bucket instead of failing loudly as an unexplained
mismatch. *)
let test_creed_coverage () =
let ordo = ordo_rows () in
let no_creed = List.filter (fun o -> o.creed = None) ordo in
Alcotest.(check (list string)) "only Good Friday has no Ordo Creed marker" [ "2025-04-18" ]
(List.map (fun o -> o.date) no_creed)
let describe_creed_mismatch (o : ordo_row) (c : colitur_row) =
Printf.sprintf "%s %S: colitur creed=%b, Ordo creed=%b (formulary=%s)" o.date o.title c.c_creed
(Option.get o.creed)
(match c.c_formulary with
| Some f -> Colitur_kernel.Slug.to_string f.MF.said
| None -> "NONE")
(* The core assertion: every Creed divergence, over all 400 days (Good
Friday excluded per [test_creed_coverage] above -- it is not a
divergence, it is a day with nothing on the Ordo's side to compare),
falls in a named, cited, adjudicated allow-list entry. Zero
unexplained. *)
let test_creed_matches_or_is_explained () =
let ordo = ordo_rows () in
let colitur = colitur_rows () in
let allow_list = load_allow_list () in
let by_id = List.map (fun e -> (e.id, e)) allow_list in
(* No known Creed divergence is adjudicated any more: L1 (RG 476(f), All
Souls' Day) was CLOSED by fixing {!Rite_ef.Rubrics_ef.creed} itself
(whole-branch review finding 1), not by re-adjudicating it -- see
expected-divergences-lms.sexp's own closure note for the citation and
the measured blast radius. [allow_list] is therefore expected to be
empty today; the [by_id]/[explained_counts] wiring below is kept
rather than deleted, because the "every declared entry must have
fired" check at the end is a real invariant worth keeping live even
while the list itself is empty -- exactly the shape a FUTURE entry of
this kind would need. *)
let unexplained = ref [] in
let explained_counts = Hashtbl.create 8 in
List.iter2
(fun (o : ordo_row) (c : colitur_row) ->
if not (String.equal o.date c.c_date) then Alcotest.failf "misaligned: ordo %s vs colitur %s" o.date c.c_date;
match o.creed with
| None -> () (* Good Friday, see test_creed_coverage *)
| Some ocreed ->
if Bool.equal ocreed c.c_creed then () else unexplained := describe_creed_mismatch o c :: !unexplained)
ordo colitur;
Alcotest.(check (list string)) "every Creed mismatch is named in the allow-list -- none unexplained" []
(List.rev !unexplained);
Hashtbl.iter
(fun id n ->
match List.assoc_opt id by_id with
| None -> Alcotest.failf "allow-list entry %s used by the comparator but not declared in %s" id allow_list_path
| Some e ->
Alcotest.(check int) (Printf.sprintf "%s: expected_rows matches the actual count" id) e.expected_rows n)
explained_counts;
(* every declared entry must actually have fired, so the allow-list
cannot silently accumulate a dead entry nothing triggers any more *)
List.iter
(fun e ->
if not (Hashtbl.mem explained_counts e.id) then
Alcotest.failf "allow-list entry %s is declared but never matched a real divergence" e.id)
allow_list
(* ---------------------------------------------------------------------- *)
(* The BVM-Saturday seasonal selection -- the coordinator addendum's own *)
(* "sharper check". Restricted to colitur's [Votive] days, which is *)
(* exactly {!Rite_ef.Lectionary_ef.is_bvm_saturday_office}'s own domain. *)
(* ---------------------------------------------------------------------- *)
let test_bvm_seasonal_selection () =
let ordo = ordo_rows () in
let colitur = colitur_rows () in
let votive_pairs =
List.filter_map
(fun (o, c) ->
match c.c_formulary with
| Some { MF.via = MF.Votive; _ } -> Some (o, c)
| _ -> None)
(List.combine ordo colitur)
in
Alcotest.(check int) "14 BVM-Saturday (Votive) days fall inside the fixture's own window" 14
(List.length votive_pairs);
let mismatches =
List.filter_map
(fun (o, c) ->
let expected = expected_bvm_numeral c.c_season ~month:(int_of_string (String.sub c.c_date 5 2))
~day:(int_of_string (String.sub c.c_date 8 2)) in
match o.bvm_numeral with
| Some got when String.equal got expected -> None
| Some got -> Some (Printf.sprintf "%s: Ordo says %s, expected %s (season-derived)" o.date got expected)
| None -> Some (Printf.sprintf "%s: colitur says Votive but the Ordo shows no BVM numeral" o.date))
votive_pairs
in
Alcotest.(check (list string)) "every BVM-Saturday numeral matches its season -- none unexplained" [] mismatches
(* Reverse direction: every Ordo BVM-numeral day is a colitur Votive day
too (rules out the Ordo naming a Saturday BVM Mass colitur never
computed the office for at all). *)
let test_bvm_numeral_implies_votive () =
let ordo = ordo_rows () in
let colitur = colitur_rows () in
let mismatches =
List.filter_map
(fun (o, c) ->
match (o.bvm_numeral, c.c_formulary) with
| Some n, Some { MF.via = MF.Votive; _ } -> ignore n; None
| Some n, other ->
Some
(Printf.sprintf "%s: Ordo shows %S Mass of BVM but colitur's via is %s" o.date n
(match other with
| Some f -> MF.source_to_string f.MF.via
| None -> "NONE"))
| None, _ -> None)
(List.combine ordo colitur)
in
Alcotest.(check (list string)) "every Ordo BVM numeral day is a colitur Votive day" [] mismatches
(* ---------------------------------------------------------------------- *)
(* Formulary override, restricted to Proper/Preceding_sunday/Common -- *)
(* see this file's own header for why Own_slug is excluded, and Votive is *)
(* covered by the BVM checks above instead. *)
(* *)
(* Whole-branch review finding 2: the ORIGINAL version of this test only *)
(* checked WHETHER a Preceding_sunday day showed an override line, never *)
(* WHICH Sunday it named -- so colitur could resume the WRONG Sunday on *)
(* every one of the 66 such days and this layer would stay green (step 3 *)
(* of the reading chain, {!Rite_ef.Lectionary_ef.readings}, is exactly the *)
(* code this was supposed to be testing). Fixed by deriving the EXPECTED *)
(* prose from {!MF.t.said}'s own resolved SLUG -- not by calling colitur's *)
(* own [sunday_slug] a second time (which would make the check tautological, *)
(* the same reasoning this file's own header already gives for *)
(* re-deriving the BVM numeral rather than calling {!Rite_ef. *)
(* Lectionary_ef.bvm_saturday_citations}). The FIRST version of this fix *)
(* instead recomputed the preceding Sunday's DATE and re-derived (season, *)
(* week) via {!Rite_ef.Temporal_ef.temporal} independently -- and was WRONG, caught by its *)
(* own assertion on the very first run: {!Rite_ef.Temporal_ef.temporal}'s raw [week] field *)
(* and the SLUG's own embedded number genuinely diverge for the last *)
(* Sunday before Advent (always slug-numbered "24", whatever the raw week *)
(* count that year -- temporal_ef.ml's own [sunday_slug], the *)
(* [same d last_sunday] branch) and for the "surplus Sundays" that resume *)
(* Epiphany's own numbering when Septuagesima cut it short (same function, *)
(* the [n > 23] branch) -- exactly the two hard cases that function's own *)
(* comment names. Parsing the number back OUT of the already-resolved slug *)
(* sidesteps both: it is not tautological with the wrong-Sunday failure *)
(* mode this whole fix exists to catch (a wrong slug still parses to a *)
(* wrong number, which still fails to match the Ordo's real text), and it *)
(* is simpler and more robust than re-deriving the two special cases a *)
(* second time by hand. *)
(* ---------------------------------------------------------------------- *)
(* English ordinal suffix: 1st, 2nd, 3rd, 4th, 11th, 12th, 13th, 21st... --
the "teens" exception applies to every multiple of 100 plus 11-13, not
just 11-13 themselves, but nothing in this fixture's own domain (weeks
1-24) ever reaches three digits, so the simpler [n mod 100] test below
is exercised fully by 11-13 alone and is not a latent bug for values
this function is actually ever called with. *)
let ordinal n =
let suffix =
if n mod 100 >= 11 && n mod 100 <= 13 then "th"
else
match n mod 10 with
| 1 -> "st"
| 2 -> "nd"
| 3 -> "rd"
| _ -> "th"
in
Printf.sprintf "%d%s" n suffix
(* [MF.t.said]'s own slug shape for every Preceding_sunday day observed in
the real fixture is [ef-<season-word>-sunday-<n>] ({!Rite_ef.Temporal_ef.sunday_slug}'s
own generic branch -- the ONLY branch that ever reaches a weekday's
[Preceding_sunday] fallback; the specially-NAMED Sundays [ef-low-sunday],
[ef-palm-sunday] etc. are caught by {!Rite_ef.Temporal_ef.named} first and never fall
through to it). Manual parsing, not [Str]/regex (deps frozen): finds the
last "-sunday-" marker and splits on it, since a season word can itself
contain hyphens ("time-after-pentecost") but never contains "-sunday-". *)
let parse_sunday_slug slug =
let prefix = "ef-" in
let plen = String.length prefix in
if String.length slug <= plen || String.sub slug 0 plen <> prefix then None
else
let body = String.sub slug plen (String.length slug - plen) in
let marker = "-sunday-" in
let mlen = String.length marker and blen = String.length body in
let rec find_last i best = if i + mlen > blen then best
else find_last (i + 1) (if String.sub body i mlen = marker then Some i else best)
in
match find_last 0 None with
| None -> None
| Some i -> (
let word = String.sub body 0 i in
let num_str = String.sub body (i + mlen) (blen - i - mlen) in
match int_of_string_opt num_str with Some n -> Some (word, n) | None -> None)
(* The Ordo's own prose, derived from [MF.t.said]'s own (season-word,
number) -- verified against every one of the 66 real Preceding_sunday
days in the fixture (test_formulary_override_matches below), not
invented from the naming convention alone. [None] means "this pair is
EXCLUDED from the mapping", handled explicitly by the caller, never
silently -- see [ascension_week_override] just below for the one real
population that lands there. *)
let expected_preceding_sunday_override (word : string) (n : int) =
match (word, n) with
| "advent", 1 -> Some "Advent Sunday"
| "advent", 2 -> Some "2nd Sunday of Advent"
| "advent", 3 -> Some "3rd Sunday of Advent (Gaudete Sunday)"
| "advent", 4 -> Some "4th Sunday of Advent"
| "septuagesima", 1 -> Some "Septuagesima Sunday"
| "septuagesima", 2 -> Some "Sexagesima Sunday"
| "septuagesima", 3 -> Some "Quinquagesima Sunday"
| "time-after-epiphany", n -> Some (Printf.sprintf "%s Sunday after the Epiphany" (ordinal n))
| "time-after-pentecost", 24 -> Some "24th & Last Sunday After Pentecost"
| "time-after-pentecost", n -> Some (Printf.sprintf "%s Sunday after Pentecost" (ordinal n))
(* [ef-easter-sunday-<n>]: Paschaltide's own numbering counts Easter
Sunday itself as 1 (Low Sunday, named separately via {!Rite_ef.Temporal_ef.named} and
so never reaching this generic branch at all, is 2), so the ordinal
PRINTED is [n - 1] -- confirmed against every one of n=3..5 in the
fixture ("2nd" through "4th" Sunday after Easter). n=6,7 are
deliberately NOT given here: see [ascension_week_override]. *)
| "easter", n when n >= 3 && n <= 5 -> Some (Printf.sprintf "%s Sunday after Easter" (ordinal (n - 1)))
| _ -> None
(* One NAMED Sunday (not a generic "ef-<season>-sunday-<n>" slug at all)
reaches [Preceding_sunday] in the real 66-day population: Christ the
King ({!Rite_ef.Temporal_ef.christ_the_king}, "the last Sunday of
October"), whose own ferias resume it the same way any other Sunday's
would. Unlike the Septuagesima trio's fixed proper names, its ORDINAL
position among the Sundays after Pentecost is not fixed -- it varies
year to year with Easter's own date -- so there is no string this
function could hard-code the way [expected_preceding_sunday_override]
does for the others. [word]/[n] cannot express it EITHER, because
{!Rite_ef.Temporal_ef.named} overrides the SLUG for that Sunday but,
confirmed directly in temporal_ef.ml ([build ~season ~slug ~colour
~rank ~week:(week d) ()], called identically whether or not [named]
matched), never the raw [week] FIELD -- so re-deriving that one field
for this one named exception is not the same mistake the first version
of this fix made re-deriving [week] WHOLESALE (that failed on the
season's own two special-numbering cases, both of which this function
sidesteps by reading the slug directly); here there is no slug number
to read in the first place, so [week] is the only source of truth,
narrowly applied to the single slug that needs it. *)
let expected_named_sunday_override slug ~year =
if String.equal slug "ef-christ-the-king" then
match TE.week (TE.christ_the_king year) with
| Some n -> Some (Printf.sprintf "%s Sunday after Pentecost" (ordinal n))
| None -> None
else None
(* [n] = 6 or 7 (Paschaltide's own numbering, see the comment above -- the
calendar Sundays traditionally called the 5th and 6th Sunday after
Easter) are STRUCTURALLY, not coincidentally, always Ascension-adjacent:
the Ascension is a fixed Easter+39 (a Thursday inside week 6), so EVERY
feria whose own [Preceding_sunday] fallback would otherwise resolve to
one of these two weeks falls between Ascension Thursday and the
following Saturday, every year, not merely in this fixture's own
2024-2025 window. A REAL finding, not a fixture artefact: the Ordo
shows "Mass of the Ascension" on all three such days this window
contains (2025-05-30, 2025-06-02, 2025-06-03 -- Friday and the
following Monday/Tuesday, the days between Ascension and the Sunday
after it that have no proper of their own), never "5th"/"6th Sunday
after Easter" -- the Missal keeps saying ASCENSION's own Mass through
this stretch, not the last numbered Sunday's. colitur's step 3 has no
notion of "inside Ascension's own after-feast period" -- it always
resumes the nearest PRECEDING SUNDAY, numbered or not -- so on these
three real days {!MF.t.said} is a plain "ef-easter-sunday-6"/"-7" slug
the Missal would never actually print as such. A genuine content gap in
colitur's reading chain, found by this fix, NOT fixed here (fixing it
means teaching step 3 or the lectionary data about Ascension's own
after-feast period, a lectionary-data change out of this fix round's
own scope) -- recorded honestly, the same way L1 in
expected-divergences-lms.sexp already records the 476(f) gap this same
branch closed, and counted below so a change to this population would
be caught rather than silently absorbed. *)
let ascension_week_override = "Mass of the Ascension"
let test_formulary_override_matches () =
let ordo = ordo_rows () in
let colitur = colitur_rows () in
let pairs = List.combine ordo colitur in
let counts = Hashtbl.create 8 in
let bump k = Hashtbl.replace counts k (1 + try Hashtbl.find counts k with Not_found -> 0) in
let bad = ref [] in
let ascension_week_count = ref 0 in
List.iter
(fun (o, c) ->
match c.c_formulary with
| Some { MF.via = MF.Proper; _ } ->
bump "proper";
if o.formulary_override <> None then
bad := Printf.sprintf "%s: Proper day but Ordo shows override %s" o.date (Option.get o.formulary_override)
:: !bad
| Some { MF.via = MF.Common; _ } ->
bump "common";
if o.formulary_override <> None then
bad := Printf.sprintf "%s: Common day but Ordo shows override %s" o.date (Option.get o.formulary_override)
:: !bad
| Some { MF.via = MF.Preceding_sunday; said } -> (
bump "preceding_sunday";
let slug = Colitur_kernel.Slug.to_string said in
let ordo_says = Printf.sprintf "Mass of %s" in
(* Try the generic [ef-<season>-sunday-<n>] shape first; fall back
to the one NAMED Sunday that also reaches this population
([expected_named_sunday_override], see its own citation) when
the slug doesn't parse that way at all. *)
let year = int_of_string (String.sub o.date 0 4) in
let expected =
match parse_sunday_slug slug with
| Some (word, n) -> expected_preceding_sunday_override word n
| None -> expected_named_sunday_override slug ~year
in
match expected with
| Some expected -> (
let expected_line = ordo_says expected in
match o.formulary_override with
| Some got when String.equal got expected_line -> ()
| Some got -> bad := Printf.sprintf "%s: colitur resumed %S, Ordo says %S" o.date expected_line got :: !bad
| None -> bad := Printf.sprintf "%s: colitur resumed %S, Ordo shows no override" o.date expected_line :: !bad)
| None -> (
(* The Ascension-week exclusion above -- checked, not
assumed: fails loudly if the Ordo's own text ever stops
matching the one string this population is adjudicated to
carry, or if a slug outside every adjudicated case above
ever reaches here. *)
match o.formulary_override with
| Some got when String.equal got ascension_week_override -> incr ascension_week_count
| Some got ->
bad :=
Printf.sprintf "%s: unmapped (colitur resumed %S) and Ordo shows %S, not the adjudicated %S" o.date
slug got ascension_week_override
:: !bad
| None ->
bad := Printf.sprintf "%s: unmapped (colitur resumed %S) and Ordo shows no override" o.date slug :: !bad))
| Some { MF.via = MF.Votive; _ } | Some { MF.via = MF.Own_slug; _ } | None -> ())
pairs;
Alcotest.(check (list string)) "every formulary-override mismatch is explained -- none unexplained" [] (List.rev !bad);
Alcotest.(check int) "179 Proper days in the window" 179 (try Hashtbl.find counts "proper" with Not_found -> 0);
Alcotest.(check int) "2 Common days in the window" 2 (try Hashtbl.find counts "common" with Not_found -> 0);
Alcotest.(check int) "66 Preceding_sunday days in the window" 66
(try Hashtbl.find counts "preceding_sunday" with Not_found -> 0);
Alcotest.(check int) "3 Preceding_sunday days fall in the Ascension-week exclusion, no more, no fewer" 3
!ascension_week_count
let test_via_distribution_totals_400 () =
let colitur = colitur_rows () in
let via_name c =
match c.c_formulary with
| None -> "none"
| Some f -> MF.source_to_string f.MF.via
in
let counts = Hashtbl.create 8 in
List.iter
(fun c -> Hashtbl.replace counts (via_name c) (1 + try Hashtbl.find counts (via_name c) with Not_found -> 0))
colitur;
let total = Hashtbl.fold (fun _ n acc -> acc + n) counts 0 in
Alcotest.(check int) "every via bucket sums to the full 400-day window" 400 total
let suite =
( "lms-ordo",
[ Alcotest.test_case "fixture SHA-256 matches its provenance note" `Quick test_fixture_checksum;
Alcotest.test_case "streams are 400 rows each, dates aligned 1:1" `Quick test_dates_align;
Alcotest.test_case "only Good Friday has no Ordo Creed marker" `Quick test_creed_coverage;
Alcotest.test_case "every Creed difference is named in the cited allow-list -- none unexplained" `Quick
test_creed_matches_or_is_explained;
Alcotest.test_case "every BVM-Saturday numeral matches its season" `Quick test_bvm_seasonal_selection;
Alcotest.test_case "every Ordo BVM numeral day is a colitur Votive day" `Quick
test_bvm_numeral_implies_votive;
Alcotest.test_case "formulary override STRING matches on Proper/Common/Preceding_sunday days" `Quick
test_formulary_override_matches;
Alcotest.test_case "the via distribution sums to the full window" `Quick test_via_distribution_totals_400
] )
|