aboutsummaryrefslogtreecommitdiff
path: root/test/test_golden_of.ml
blob: fd4f78156323e38116058a2c0346d88ebed2cb74 (plain) (blame)
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
(* Task 6 (2026-08-26-colitur-of-phases-3-5): golden pins, the OF
   counterpart of test_golden.ml -- validation layer 5, one rite down.

   *** THE ONE RULE THIS FILE IS BUILT AROUND (test_golden.ml's own,
   restated for this file) ***

   A golden test blesses whatever it is given. Every other layer this
   branch built derives its expectation from something independent of
   colitur's own output -- a property (test_validate_of.ml), a second
   implementation (test_litcal_of.ml). This layer's expectation comes from
   ME, so every literal string below was checked BY HAND, against the
   primary-source citations already carried by temporal_of.ml/
   precedence_of.ml/the amendment files (each pin's own comment names
   which), BEFORE it was typed in here -- never copied from a `colitur
   day`/`readings` run and then rationalised. Every date and weekday
   claim below was independently cross-checked against
   {!Colitur_kernel.Computus.gregorian_easter} arithmetic done BY HAND
   (Easter date + a day-offset, or a `date -d` cross-check for a fixed
   date), the same discipline test_golden.ml's own header states for its
   own pins.

   Six landmark/tricky dates, per this task's own brief, at minimum:
   1. A year Ordinary Time skips a week (2026 -- already independently
      hand-verified, twice over, by test_temporal_of.ml's own
      [test_ordinary_time_resumption]; reused here, not re-derived, since
      re-deriving the SAME arithmetic a second time would not add
      confidence, only a second literal to keep in sync).
   2. A year 24 December falls on a Sunday (2028; the Advent IV case --
      commit a2fba71d, "fix(of): Nativity Vigil no longer suppresses a
      Sunday of Advent").
   3. A year the Annunciation falls in Holy Week (2027; Normae n. 60's
      fixed Easter+8 transfer).
   4. Mary, Mother of the Church (Easter+50).
   5. All Souls (2 November).
   6. The Sacred Heart (Easter+68).
   Plus 17 December's own date-keyed reading (Gen 49:2,8-10 / Mt 1:1-17,
   fixed earlier on this branch, commit b6d0eba0), and, added by the
   fix-wave-2 review (I8), 25 December's own reading (Isa 52:7-10 /
   Jn 1:1-18, hand-authored from OLM 1981 -- see [test_christmas_day_
   reading]'s own header). *)

module Cal = Colitur_kernel.Calendar
module Layer = Colitur_kernel.Layer
module Overlay = Colitur_kernel.Overlay
module LD = Colitur_kernel.Liturgical_day
module Slug = Colitur_kernel.Slug
module Date = Colitur_kernel.Date
module Cel = Colitur_kernel.Celebration
module Colour = Colitur_kernel.Colour
module Citation = Colitur_kernel.Citation
module Temporal = Colitur_kernel.Temporal
module Subject = Colitur_kernel.Subject
module V = Rite_of.Vocab_of

let calendar_path = "../data/of/calendar-2002.sexp"
let amendments_dir = "../data/of/amendments/"
let of_lectionary_path = "../data/of/lectionary.sexp"

let amendment_files =
  [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp";
    "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp";
    "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp";
    "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp";
    "013-john-henry-newman.sexp" ]

(* Duplicated verbatim from test_rite_of.ml/test_validate_of.ml -- see
   either file's own header for why (no .mli any of them could share it
   through). *)
let real_of_layer =
  let base =
    match Layer.load V.rank_of_sexp calendar_path with
    | Ok l -> l
    | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" calendar_path e)
  in
  let overlays =
    List.map
      (fun name ->
        let path = amendments_dir ^ name in
        match Overlay.load V.rank_of_sexp path with
        | Ok o -> o
        | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" path e))
      amendment_files
  in
  let layer, diagnostics = Overlay.merge base overlays in
  if diagnostics <> [] then
    failwith
      (Printf.sprintf "unexpected amendment diagnostics: %s"
         (String.concat "; " (List.map Overlay.diagnostic_to_string diagnostics)));
  layer

let real_of_lectionary =
  match Colitur_kernel.Lectionary.load of_lectionary_path with
  | Ok l -> l
  | Error e -> failwith (Printf.sprintf "%s: failed to load: %s" of_lectionary_path e)

let real_of_rite = Rite_of.context ~lectionary:real_of_lectionary

let mk y m d = match Date.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e
let fetch y m d = Cal.day real_of_rite real_of_layer (mk y m d)

let slug_s (c : V.rank Cel.t) = Slug.to_string c.Cel.slug
let rank_s (c : V.rank Cel.t) = V.rank_to_string c.Cel.rank
let colour_s (c : V.rank Cel.t) = Colour.to_string c.Cel.colour
let subject_s (c : V.rank Cel.t) = Subject.to_string c.Cel.subject

(* [describe]'s own five components mirror {!Colitur_kernel.Liturgical_day
   .t}'s own promise never to lose a field, the same discipline
   test_golden.ml's header argues for at length -- one string per day, not
   five separate checks, so a one-line diff on failure still names the day
   and shows exactly which field changed.

   [comms] is included even though it is STRUCTURALLY ALWAYS "[]" for this
   rite ({!Rite_of.Precedence_of.admit} never returns anything else,
   Precedence_of.mli's own citation) -- kept in the format rather than
   dropped, so a future rite-level change that somehow populated it would
   still show up in every existing pin's own diff, not silently pass. *)
let describe (day : (V.season, V.rank) LD.t) =
  let t = day.LD.temporal in
  let week = match t.Temporal.week with Some n -> string_of_int n | None -> "-" in
  let comms =
    List.map (fun (c, _) -> slug_s c) day.LD.commemorations |> List.sort compare |> String.concat ","
  in
  let tin = match day.LD.transferred_in with None -> "-" | Some c -> slug_s c in
  let tout =
    List.map (fun (c, d) -> Printf.sprintf "%s->%s" (slug_s c) (Date.to_iso8601 d)) day.LD.transferred_out
    |> List.sort compare |> String.concat ","
  in
  Printf.sprintf "%s %s season=%s week=%s slug=%s rank=%s colour=%s subject=%s comms=[%s] in=%s out=[%s]"
    (Date.to_iso8601 day.LD.date)
    (Date.weekday_to_string t.Temporal.weekday)
    (V.season_to_string t.Temporal.season)
    week (slug_s day.LD.observed) (rank_s day.LD.observed) (colour_s day.LD.observed) (subject_s day.LD.observed)
    comms tin tout

let check ~msg y m d expected = Alcotest.(check string) msg expected (describe (fetch y m d))

let describe_readings (day : (V.season, V.rank) LD.t) =
  let part_ref p =
    match List.find_opt (fun (c : Citation.t) -> c.Citation.part = p) day.LD.citations with
    | Some c -> c.Citation.reference
    | None -> "-"
  in
  Printf.sprintf "%s slug=%s first=%s gospel=%s"
    (Date.to_iso8601 day.LD.date)
    (slug_s day.LD.observed) (part_ref Citation.First) (part_ref Citation.Gospel)

let check_readings ~msg y m d expected = Alcotest.(check string) msg expected (describe_readings (fetch y m d))

(* ------------------------------------------------------------------ *)
(* 1. Ordinary Time skips a week: 2026. Pentecost is 24 May 2026 (Easter  *)
(* 5 April + 49); block A tops out at week 6 (Shrove Tuesday, 17 Feb,     *)
(* independently hand-verified against Ash Wednesday 18 Feb); Normae     *)
(* n. 43-44's own two-block arithmetic resumes the Monday after Pentecost *)
(* (25 May) at week 8, not 7 -- week 7 never occurs anywhere in Ordinary  *)
(* Time that civil year (test_temporal_of.ml's own                       *)
(* [test_ordinary_time_resumption], which checks this exhaustively over  *)
(* the WHOLE civil year, not merely this one pinned Monday). Pinned here  *)
(* through the ASSEMBLED pipeline (Rite_of.context/Calendar.day), not     *)
(* Temporal_of directly -- the same "genuinely different code path"       *)
(* argument test_validate_of.ml's own [ot_and_coverage_of_year] makes.    *)
(* ------------------------------------------------------------------ *)

let test_ordinary_time_skips_a_week_2026 () =
  (* subject=temporal, not =lord: {!Rite_of.Temporal_of.named}'s own tuple
     shape (season, slug, colour, rank) carries no subject field at all,
     so every day it builds (Nativity, Epiphany, Ascension, Pentecost, Ash
     Wednesday, Palm Sunday, Easter, the Easter Octave, Trinity, Corpus
     Christi, Christ the King) defaults to {!Colitur_kernel.Subject
     .Temporal} -- {!Rite_of.Precedence_of.band}'s own entry-2 branch
     routes these by SLUG membership ([entry_2_named]), never by subject,
     so this is not a gap, just a different (and correct) tagging
     convention from the DATA-origin solemnities pinned elsewhere in this
     file (Sacred Heart, the Annunciation, All Souls), which carry a real
     [subject] field in their own calendar-2002.sexp/amendment record. *)
  check ~msg:"2026-05-24 Pentecost: Easter+49, red, block A's own last Sunday" 2026 5 24
    "2026-05-24 sunday season=easter week=8 slug=of-pentecost rank=sollemnitas colour=red subject=temporal \
     comms=[] in=- out=[]";
  check ~msg:"2026-05-25 (Mon after Pentecost) resumes Ordinary Time at week 8, SKIPPING week 7" 2026 5 25
    "2026-05-25 monday season=ordinary-time week=8 slug=mary-mother-of-the-church rank=memoria-obligatoria \
     colour=white subject=bvm comms=[] in=- out=[]"

(* ------------------------------------------------------------------ *)
(* 2. 24 December falls on a Sunday: 2028 (and, symmetrically, 2034 --   *)
(* both inside commit a2fba71d's own worked examples). Before that fix,   *)
(* the Vigil Mass of the Nativity silently displaced the Fourth Sunday of *)
(* Advent (Tabula I.2/Normae n. 5 -- a privileged Sunday outranks         *)
(* everything but a HIGHER Tabula entry, and the Vigil is Tabula I.3).    *)
(* After it, 24 December on a Sunday resolves as the Fourth Sunday of     *)
(* Advent itself, violet (Advent's own colour, not Gaudete's rose --      *)
(* that is week 3 only, IGMR 346(c)/[V.season]'s own [is_rose_sunday]).   *)
(* ------------------------------------------------------------------ *)

let test_advent_iv_on_christmas_eve_2028 () =
  check ~msg:"2028-12-24 (a Sunday): the Fourth Sunday of Advent, not the Vigil (Tabula I.2 over I.3)" 2028 12 24
    "2028-12-24 sunday season=advent week=4 slug=of-advent-sunday-4 rank=sollemnitas colour=violet \
     subject=temporal comms=[] in=- out=[]";
  (* The day immediately before it: still the Third Week of Advent, an
     ordinary (non-rose) Saturday feria -- confirms the season/week
     boundary itself sits in the right place, not merely that 24 December
     alone reads correctly. *)
  check ~msg:"2028-12-23: still Advent week 3, an ordinary violet feria" 2028 12 23
    "2028-12-23 saturday season=advent week=3 slug=of-advent-3-saturday rank=feria colour=violet subject=temporal \
     comms=[] in=- out=[]";
  (* And the day after: Christmas Day itself, entirely unaffected by which
     office 24 December carried. *)
  check ~msg:"2028-12-25: the Nativity, unaffected" 2028 12 25
    "2028-12-25 monday season=christmas week=- slug=of-nativity rank=sollemnitas colour=white subject=temporal \
     comms=[] in=- out=[]"

(* The symmetric 2034 witness -- a second, independent year, not a
   re-check of the same arithmetic (a fix that happened to work for one
   specific weekday alignment but not the general rule would show up as a
   difference here). *)
let test_advent_iv_on_christmas_eve_2034 () =
  check ~msg:"2034-12-24 (a Sunday): the Fourth Sunday of Advent" 2034 12 24
    "2034-12-24 sunday season=advent week=4 slug=of-advent-sunday-4 rank=sollemnitas colour=violet \
     subject=temporal comms=[] in=- out=[]"

(* ------------------------------------------------------------------ *)
(* 3. The Annunciation in Holy Week: 2027 (Easter 28 March 2027, so 25    *)
(* March is Easter-3, the Thursday of Holy Week). Normae n. 60's own      *)
(* FIRST, fixed-destination rule (not the general "nearest later free     *)
(* day" search rule 3): "Sollemnitas... Annuntiationis Domini,            *)
(* quotiescumque occurrit aliquo die Hebdomadae sanctae, semper ad feriam *)
(* II post dominicam II Paschae erit transferenda" -- ALWAYS to the       *)
(* Monday after the Second Sunday of Easter, Easter+8, here 5 April 2027. *)
(* Pinned as THREE dates, not one: 25 March itself (Holy Thursday's own   *)
(* office wins outright, IGMR 346(a)'s "celebrationibus Domini, quae non  *)
(* sint de eius Passione" -- white, not Passiontide violet/red), the      *)
(* departure recorded in [out], and the arrival on 5 April recorded in    *)
(* [in] -- Calendar's own transfer bookkeeping, both ends. *)
(* ------------------------------------------------------------------ *)

let test_annunciation_holy_week_2027 () =
  check ~msg:"2027-03-25 (Holy Thursday, Easter-3): the day's own office wins, white, and records the \
              Annunciation's own departure"
    2027 3 25
    "2027-03-25 thursday season=lent week=6 slug=of-lent-6-thursday rank=feria colour=white subject=temporal \
     comms=[] in=- out=[annunciation-of-the-lord->2027-04-05]";
  check ~msg:"2027-04-05 (Easter+8, the Monday after the Second Sunday of Easter): the Annunciation arrives" 2027 4
    5
    "2027-04-05 monday season=easter week=2 slug=annunciation-of-the-lord rank=sollemnitas colour=white \
     subject=lord comms=[] in=annunciation-of-the-lord out=[]"

(* ------------------------------------------------------------------ *)
(* 4. Mary, Mother of the Church: Easter+50, the Monday after Pentecost   *)
(* (data/of/amendments/006-mary-mother-of-the-church.sexp's own citation, *)
(* CDW decree 11 February 2018, Prot. N. 1037/2017, AAS 110 (2018)       *)
(* 437-438). ALREADY the day this file's own [test_ordinary_time_skips_a_ *)
(* week_2026] pins (2026-05-25) -- not re-pinned a second time under a    *)
(* different date; that pin's own [msg] is worded to name both facts it   *)
(* carries (the week-8 resumption AND Mother of the Church herself), the  *)
(* SAME "one string, several independently-true facts" economy           *)
(* test_golden.ml's own header argues for, rather than a second literal   *)
(* asserting the identical field values under a different label. *)
(* ------------------------------------------------------------------ *)

(* ------------------------------------------------------------------ *)
(* 5. All Souls: 2 November, every year, unconditionally (a fixed date,   *)
(* not movable) -- Tabula I.3 ("Commemoratio omnium fidelium              *)
(* defunctorum"), tagged Sollemnitas on the Tabula's own authority        *)
(* despite the calendarium page itself printing no grade word             *)
(* (precedence_of.ml's own [band] entry-3 citation has the full           *)
(* argument). Violet (not white, not black) -- shipped                    *)
(* data/of/calendar-2002.sexp's own colour, already independently         *)
(* exercised by test_precedence_of.ml's own                               *)
(* [test_all_souls_beats_an_ordinary_sunday] against a DIFFERENT year     *)
(* (2025-11-02, itself a Sunday); 2026 is chosen here instead so this      *)
(* file's own pin is not a byte-identical duplicate of that one. ------- *)

let test_all_souls_2026 () =
  check ~msg:"2026-11-02: All Souls, violet, every year unconditionally" 2026 11 2
    "2026-11-02 monday season=ordinary-time week=31 slug=all-souls rank=sollemnitas colour=violet subject=saint \
     comms=[] in=- out=[]"

(* ------------------------------------------------------------------ *)
(* 6. The Sacred Heart: Easter+68 (calendar-2002.sexp's own              *)
(* [Easter_offset 68] entry) -- Easter 2026 is 5 April, so Easter+68 is   *)
(* 12 June 2026 (25 days left in April + 31 in May + 12 = 68, hand-       *)
(* verified against {!Colitur_kernel.Computus.gregorian_easter} directly, *)
(* not merely trusted from the offset). White, Sollemnitas, subject Lord  *)
(* -- shipped data, matching the Missal's own title ("SACRATISSIMI        *)
(* CORDIS IESU"). ------------------------------------------------------ *)

let test_sacred_heart_2026 () =
  Alcotest.(check string) "Easter 2026 is really 5 April (the Sacred Heart's own Easter+68 anchor)" "2026-04-05"
    (Date.to_iso8601 (Colitur_kernel.Computus.gregorian_easter 2026));
  check ~msg:"2026-06-12 (Easter+68): the Sacred Heart of Jesus" 2026 6 12
    "2026-06-12 friday season=ordinary-time week=10 slug=sacred-heart-of-jesus rank=sollemnitas colour=white \
     subject=lord comms=[] in=- out=[]"

(* ------------------------------------------------------------------ *)
(* 7. 17 December's own date-keyed reading (OLM n. 69.3, commit b6d0eba0, *)
(* "fix(of-lectionary): stop serving drifting readings for O-Antiphon and *)
(* Christmas-season dates"): Genesis 49:2,8-10 / Matthew 1:1-17, fixed by *)
(* CIVIL DATE, not by the day's own weekday-keyed ferial slug -- this pin *)
(* is what would have caught the original bug (a citation that silently   *)
(* drifted year to year on this date before the fix), pinned through the  *)
(* full resolved pipeline rather than test_lectionary_of.ml's own more    *)
(* narrowly-scoped unit test for the same fact. Raw reference strings     *)
(* (data/of/lectionary.sexp's own literal text, "Genesis"/"Matthew" in    *)
(* full), not a rendered siglum -- the same discipline test_golden.ml's   *)
(* own [describe_readings] follows for EF. *)
(* ------------------------------------------------------------------ *)

let test_december_17_reading () =
  check_readings ~msg:"2026-12-17: the O-Antiphon date-keyed reading, Genesis 49:2,8-10 / Matthew 1:1-17" 2026 12
    17 "2026-12-17 slug=of-advent-3-thursday first=Genesis 49:2,8-10 gospel=Matthew 1:1-17";
  (* A second, independent civil year -- OLM n. 69.4's weekday-cycle
     letter flips on the liturgical year's own parity (Lectionary_of
     .weekday_cycle), so a date-keyed reading that accidentally still
     routed through the weekday-keyed path would likely only fail in
     roughly half of all years -- this second year is chosen from the
     OTHER cycle letter than 2026's own (test_lectionary_of.ml's own
     [test_date_keyed_no_drift] already proves this pair directly at the
     Lectionary_of level; repeated here through the full pipeline for the
     same reason [test_advent_iv_on_christmas_eve_2034] repeats 2028's own
     shape in a second year). *)
  check_readings ~msg:"2027-12-17: the same date-keyed reading, a second civil year, the other weekday-cycle \
                        letter"
    2027 12 17 "2027-12-17 slug=of-advent-3-friday first=Genesis 49:2,8-10 gospel=Matthew 1:1-17"

(* ------------------------------------------------------------------ *)
(* 8. Christmas Day itself: fix wave I8 (final-review.md, 2026-08-25-    *)
(* colitur-of-phases-3-5). lectio's own 988 keys never covered the       *)
(* Christmas DAY Mass at all (only the Vigil) -- `colitur readings       *)
(* --rite of` used to print "- | -" on 25 December, every year (pinned,  *)
(* before this fix, by test_validate_of.ml's own exhaustive-sweep        *)
(* counter: fired on all 8 416 swept years). tools/                      *)
(* bootstrap_lectionary_of.ml's own [hand_authored] table now injects it *)
(* directly from OLM 1981's own "16 Ad Missam in die"                    *)
(* (docs/research/of/olm-1981-ocr.txt:4513-4520): First = Isaiah         *)
(* 52:7-10, Gospel = John 1:1-18 (OLM's own LONGER form -- the file's own*)
(* LINEAGE section already discloses that short/long-form choices are    *)
(* not modelled anywhere in this data, so this is an application of an   *)
(* existing, stated limitation, not a new one). Fixed civil-date entry,  *)
(* not cycle-lettered (the Christmas Day Mass does not vary by A/B/C or  *)
(* I/II), so a single year is sufficient -- unlike item 7 above, there is*)
(* no cycle-letter axis to re-confirm in a second year. ------------------ *)

let test_christmas_day_reading () =
  check_readings ~msg:"2026-12-25: the Christmas Day Mass, hand-authored from OLM 1981 (Isa 52:7-10/John \
                        1:1-18) -- was \"- | -\" before fix wave I8"
    2026 12 25 "2026-12-25 slug=of-nativity first=Isaiah 52:7-10 gospel=John 1:1-18"

let suite =
  ( "golden-of",
    [ Alcotest.test_case "Ordinary Time skips a week (2026); Mary, Mother of the Church" `Quick
        test_ordinary_time_skips_a_week_2026;
      Alcotest.test_case "Advent IV on Christmas Eve (2028)" `Quick test_advent_iv_on_christmas_eve_2028;
      Alcotest.test_case "Advent IV on Christmas Eve, a second year (2034)" `Quick
        test_advent_iv_on_christmas_eve_2034;
      Alcotest.test_case "the Annunciation in Holy Week, transferred to Easter+8 (2027)" `Quick
        test_annunciation_holy_week_2027;
      Alcotest.test_case "All Souls (2026)" `Quick test_all_souls_2026;
      Alcotest.test_case "the Sacred Heart, Easter+68 (2026)" `Quick test_sacred_heart_2026;
      Alcotest.test_case "17 December's own date-keyed reading, two civil years" `Quick test_december_17_reading;
      Alcotest.test_case "Christmas Day's own reading (fix wave I8)" `Quick test_christmas_day_reading
    ] )