1 files changed, 219 insertions, 5 deletions

diff --git a/test/test_oracle.ml b/test/test_oracle.ml
index 2d7060b..656a437 100644
--- a/test/test_oracle.ml
+++ b/test/test_oracle.ml
@@ -377,18 +377,25 @@ let colour_to_char = function
 
 let en = Lang.of_string_exn "en"
 
-let colitur_rows_2026_2027 () =
+(* Parameterised by year (the 2038 oracle extension, 2026-08-17): this used
+   to be [colitur_rows_2026_2027], hardcoded to the one fixture window. The
+   resolution walk starts a year EARLY -- [from_year - 1] -- because a
+   liturgical year is Advent-anchored and straddles two civil years, so
+   1 January of [from_year] belongs to the liturgical year that opened the
+   previous November (calendar.mli, and bin/main.ml's own [day_report] does
+   exactly the same for the same reason). *)
+let colitur_rows ~from_year ~to_year =
   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 = 2025 to 2027 do
+  for y = from_year - 1 to to_year 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 2026 1 1) in
-  let stop = mk 2027 12 31 in
+  let d = ref (mk from_year 1 1) in
+  let stop = mk to_year 12 31 in
   while Date.compare !d stop <= 0 do
     (match Hashtbl.find_opt by_rata (Date.to_rata !d) with
     | Some day ->
@@ -1476,7 +1483,7 @@ type outcome = Matched | Explained of string | Unexplained of field list
 
 let compare_streams () =
   let oracle = oracle_rows () in
-  let colitur = colitur_rows_2026_2027 () in
+  let colitur = colitur_rows ~from_year:2026 ~to_year:2027 in
   (oracle, colitur)
 
 let classify oracle colitur =
@@ -1714,3 +1721,210 @@ let suite =
         "identity corroboration: matched titles' oracle id-rank agrees with colitur's own rank" `Quick
         test_identity_rank_corroboration
     ] )
+
+(* ====================================================================== *)
+(* The 2038 oracle extension (2026-08-17)                                 *)
+(* ====================================================================== *)
+
+(* A SECOND, INDEPENDENT oracle year, deliberately kept apart from the
+   2026-2027 comparison above rather than folded into it.
+
+   WHY 2038. Register §6.7 recorded that step 4 of the reading chain -- the
+   Common route -- had no external witness at all. Only five saints route
+   through a Common, and across 2005-2050 they are the OBSERVED office on
+   five days total; not one falls in the 2026-2027 window. 2038 is the year
+   covering TWO of the five at once (`sts-felicitas-perpetua` 6 March,
+   `frances-rome` 9 March), which is why it and not 2035 or 2046.
+
+   WHY SEPARATE. This fixture is a LIVE capture of missalemeum, where the
+   2026-2027 one is derived from lectio's archived snapshot, and
+   docs/research/sources.md already records that the live endpoint HAS
+   DRIFTED from that snapshot. Merging them would put two versions of the
+   same source behind one set of expectations, and a future disagreement
+   could not be attributed to either the calendar or the drift.
+
+   WHY A NARROWER COMPARISON. This compares rank, colour, and the two
+   reading citations -- NOT commemorations or observed-identity. Those axes
+   are worth having, but the machinery above that implements them is built
+   around a hand-built, date-literal allow-list of 28 entries specific to
+   2026-2027, and re-deriving an equivalent for a second year is its own
+   task. What is asserted here is asserted fully; what is not compared is
+   named, here, rather than left to be discovered. *)
+
+let fixture_2038_path = "fixtures/missalemeum-ef-2038.txt"
+let fixture_2038_sha256 = "2ac17136be5f6a831bb115ab62f0bb993f69973fdd847d269b43915746ef2151"
+
+(* Citation notation differs between the two sources in ways that are not
+   calendar disagreements at all: book abbreviations ("Ecclus"/"Sir",
+   "Joann"/"John", "Luc"/"Luke") and punctuation of the same verse range.
+   Layer 3 normalises the same way and for the same reason
+   (test_differential.ml's own A/B normalisation). Normalising here keeps
+   this comparison about WHICH VERSES, which is the thing under test. *)
+let norm_citation s =
+  let s = String.lowercase_ascii s in
+  (* Each pair maps the LONGER/rarer spelling onto the shorter one used by
+     the other side. Checked for self-collision: no replacement's target
+     contains its own source as a substring ("luke" does not contain "luc",
+     "mark" does not contain "marc"), so applying them is idempotent and
+     order-independent. Every entry here was added because a real 2038 row
+     needed it, never speculatively. *)
+  let subst =
+    [ ("ecclus", "sir"); ("eccli", "sir"); ("joann", "john"); ("matth", "matt");
+      ("luc", "luke"); ("marc", "mark") ]
+  in
+  let s = List.fold_left (fun acc (a, b) ->
+      let bl = String.length a in
+      let buf = Buffer.create (String.length acc) in
+      let i = ref 0 in
+      while !i < String.length acc do
+        if !i + bl <= String.length acc && String.sub acc !i bl = a then begin
+          Buffer.add_string buf b; i := !i + bl end
+        else begin Buffer.add_char buf acc.[!i]; incr i end
+      done;
+      Buffer.contents buf) s subst
+  in
+  String.to_seq s
+  |> Seq.filter (fun ch -> (ch >= 'a' && ch <= 'z') || (ch >= '0' && ch <= '9'))
+  |> String.of_seq
+
+(* Every 2038 divergence class, each pointing at where it is adjudicated.
+   These are NOT new rulings: all six were already decided, and 2038 is an
+   independent year re-confirming them. The counts are pinned so a change in
+   any class fails loudly. *)
+let m21_2038_slugs = m21_colour_slugs
+
+let classify_2038 (c : colitur_row) (o : oracle_row) diffs =
+  let title = o.o_title in
+  let contains hay needle =
+    let nh = String.length needle and lh = String.length hay in
+    let rec at i = i + nh <= lh && (String.sub hay i nh = needle || at (i + 1)) in
+    nh = 0 || at 0
+  in
+  let first_is s = match c.c_first with Some f -> contains f s | None -> false in
+  if contains title "Mass of the B. V. M." then Some "BVM-SATURDAY-MASS (M26 shape 1)"
+  else if first_is "Col 1:12-20" then Some "CHRIST-THE-KING-WEEK (M26 shape 2b)"
+  else if diffs = [ Colour_f ] && List.mem c.c_observed_slug m21_2038_slugs then Some "COLOUR (M21)"
+  else if first_is "Judith" then Some "JUDITH (M28, register 6.6)"
+  else if c.c_observed_slug = "sts-felicitas-perpetua" then Some "PERPETUA-COMMON (register 6.8)"
+  else if c.c_observed_slug = "ef-nativity" then Some "CHRISTMAS-MULTI-MASS (M27)"
+  else if first_is "Dan 14:27, 28-42" then Some "MISSAL-TWO-PART-CITATION (register 6.9)"
+  else None
+
+let diffs_2038 (c : colitur_row) (o : oracle_row) =
+  let d = ref [] in
+  if c.c_rank <> o.o_rank then d := Rank :: !d;
+  if not (List.mem c.c_colour o.o_colours) then d := Colour_f :: !d;
+  (match (c.c_first, o.o_first) with
+   | Some a, Some b when norm_citation a <> norm_citation b -> d := First_mismatch :: !d
+   | _ -> ());
+  (match (c.c_gospel, o.o_gospel) with
+   | Some a, Some b when norm_citation a <> norm_citation b -> d := Gospel_mismatch :: !d
+   | _ -> ());
+  List.rev !d
+
+let compare_2038 () =
+  let oracle = List.map oracle_row_of_line (read_lines fixture_2038_path) in
+  let colitur = colitur_rows ~from_year:2038 ~to_year:2038 in
+  let by_date = Hashtbl.create 400 in
+  List.iter (fun (c : colitur_row) -> Hashtbl.replace by_date c.c_date c) colitur;
+  List.filter_map
+    (fun (o : oracle_row) ->
+      match Hashtbl.find_opt by_date o.o_date with
+      | None -> None
+      | Some c ->
+          let diffs = diffs_2038 c o in
+          if diffs = [] then None else Some (o.o_date, diffs, classify_2038 c o diffs, c, o))
+    oracle
+
+let test_2038_fixture_checksum () =
+  Alcotest.(check string) "2038 fixture SHA-256 matches its provenance note" fixture_2038_sha256
+    (sha256_of_file fixture_2038_path)
+
+let test_2038_dates_align () =
+  let oracle = List.map oracle_row_of_line (read_lines fixture_2038_path) in
+  let colitur = colitur_rows ~from_year:2038 ~to_year:2038 in
+  Alcotest.(check int) "oracle is 365 rows" 365 (List.length oracle);
+  Alcotest.(check int) "colitur is 365 rows" 365 (List.length colitur);
+  Alcotest.(check (list string)) "dates align 1:1"
+    (List.map (fun (o : oracle_row) -> o.o_date) oracle)
+    (List.map (fun (c : colitur_row) -> c.c_date) colitur)
+
+let test_2038_every_difference_is_classified () =
+  let unexplained =
+    compare_2038 ()
+    |> List.filter_map (fun (date, diffs, cls, c, o) ->
+           match cls with
+           | Some _ -> None
+           | None ->
+               Some
+                 (Printf.sprintf "%s: %s -- colitur=(%s rank=%d colour=%c first=%s) oracle=(%s rank=%d first=%s)"
+                    date
+                    (String.concat "," (List.map field_name diffs))
+                    c.c_observed_slug c.c_rank c.c_colour
+                    (Option.value c.c_first ~default:"-")
+                    o.o_title o.o_rank
+                    (Option.value o.o_first ~default:"-")))
+  in
+  Alcotest.(check (list string)) "every 2038 difference falls in a named, adjudicated class" []
+    unexplained
+
+let test_2038_class_counts () =
+  let tbl = Hashtbl.create 8 in
+  List.iter
+    (fun (_, _, cls, _, _) ->
+      match cls with
+      | Some k -> Hashtbl.replace tbl k (1 + Option.value (Hashtbl.find_opt tbl k) ~default:0)
+      | None -> ())
+    (compare_2038 ());
+  let actual = Hashtbl.fold (fun k n acc -> (k, n) :: acc) tbl [] |> List.sort compare in
+  (* Measured 2026-08-17 against the live capture this fixture pins. Each
+     class is adjudicated elsewhere and merely RE-CONFIRMED here, in a year
+     entirely independent of the one those rulings were made in. *)
+  let expected =
+    [ ("BVM-SATURDAY-MASS (M26 shape 1)", 13);
+      ("CHRIST-THE-KING-WEEK (M26 shape 2b)", 2);
+      ("CHRISTMAS-MULTI-MASS (M27)", 1);
+      ("COLOUR (M21)", 7);
+      ("JUDITH (M28, register 6.6)", 2);
+      ("MISSAL-TWO-PART-CITATION (register 6.9)", 1);
+      ("PERPETUA-COMMON (register 6.8)", 1)
+    ]
+    |> List.sort compare
+  in
+  Alcotest.(check (list (pair string int))) "2038 divergence classes and their counts" expected actual
+
+(* The point of the whole exercise: 2038 is the only year in 2005-2050 where
+   a Common-routed saint is the observed office AND an oracle exists for it.
+   Both days are asserted directly, by date, so a regression in step 4 cannot
+   hide inside an aggregate count. Perpetua is a KNOWN divergence (register
+   §6.8 -- missalemeum has the two martyrs classified as Virgins and serves
+   the Virgins Common; the Missal directs "de Communi non Virginum I loco",
+   scan1:27634-27635); Frances of Rome must MATCH outright. *)
+let test_2038_common_route_days () =
+  let rows = compare_2038 () in
+  let diff_for d = List.find_opt (fun (date, _, _, _, _) -> date = d) rows in
+  (match diff_for "2038-03-09" with
+  | None -> ()
+  | Some (_, diffs, _, c, o) ->
+      Alcotest.failf "2038-03-09 (frances-rome, Common of Non-Virgins II) should agree: %s (colitur first=%s, oracle first=%s, oracle title=%s)"
+        (String.concat "," (List.map field_name diffs))
+        (Option.value c.c_first ~default:"-")
+        (Option.value o.o_first ~default:"-")
+        o.o_title);
+  match diff_for "2038-03-06" with
+  | Some (_, _, Some cls, _, _) ->
+      Alcotest.(check string) "2038-03-06 is the adjudicated Perpetua divergence"
+        "PERPETUA-COMMON (register 6.8)" cls
+  | _ -> Alcotest.fail "2038-03-06 was expected to differ (register §6.8) and did not"
+
+let suite_2038 =
+  ( "oracle (missalemeum, EF, 2038 -- the Common route)",
+    [ Alcotest.test_case "2038 fixture SHA-256 matches its provenance note" `Quick
+        test_2038_fixture_checksum;
+      Alcotest.test_case "streams are 365 rows each, dates aligned 1:1" `Quick test_2038_dates_align;
+      Alcotest.test_case "every difference falls in a named, adjudicated class" `Quick
+        test_2038_every_difference_is_classified;
+      Alcotest.test_case "divergence classes and their counts are pinned" `Quick test_2038_class_counts;
+      Alcotest.test_case "the two Common-route days: Frances agrees, Perpetua is the known divergence"
+        `Quick test_2038_common_route_days
+    ] )