diff options
Diffstat (limited to 'test/test_differential.ml')
| -rw-r--r-- | test/test_differential.ml | 585 |
1 files changed, 585 insertions, 0 deletions
diff --git a/test/test_differential.ml b/test/test_differential.ml new file mode 100644 index 0000000..a9bdb91 --- /dev/null +++ b/test/test_differential.ml @@ -0,0 +1,585 @@ +(* Task 15: differential harness vs lectio (sibling project, Go), EF only, + 2005-2050 -- validation layer 3 of the design spec's five (colitur CLAUDE.md + "Validation" section; layers 1-2, Types and Property, are already built and + green). lectio's own EF stream is committed as a fixture + (test/fixtures/lectio-ef-2005-2050.txt, provenance -- including the + SHA-256 this file's own [test_fixture_checksum] asserts, so a hand-edit or + partial re-copy of the fixture fails loudly rather than silently becoming + an unlabelled snapshot -- in the sibling .provenance file next to it); + colitur's side is recomputed fresh from this library on every run, through + the SAME pipeline `colitur day` uses (Colitur_kernel.Calendar over the + real data/ef/sanctoral.sexp + adjustments.sexp), not the compiled binary. + + *** THREE STATED LIMITS THIS COMPARATOR DOES NOT PRETEND TO EXCEED *** + + 1. Commemorations are NOT compared. lectio's trailing "+other-slug" tokens + are the LOSING sanctoral candidates for the day (its own dumper's doc + comment says so), not an RG 111 admitted set -- lectio has no RG 111 + admission logic at all. Comparing that column would compare colitur's + real admitted commemorations against lectio's rejects, which proves + nothing. Only the seven leading columns (date weekday season week slug + rank colour) are read from either stream. + + 2. lectio's own EF oracle test (~/git/projects/lectio, + internal/calendar/oracle_ef_test.go) asserts ONLY season, strictly, + against missalemeum, and ONLY for 2025-2026. Rank and colour are logged + there, never asserted. So lectio's advertised "0-error vs references + 2005-2050" covers season-exactness for the EF, not full-row-exactness. + A rank or colour difference below is therefore NOT presumptive evidence + that colitur is wrong -- every one is adjudicated against the Missal/RG + register directly (data/ef/expected-divergences.sexp), never against + lectio's say-so. (Layer 4, the oracle differential against missalemeum + itself, is what actually validates rank and colour; that is a later + task.) + + 3. The WEEK column is not compared, at all, on either side. Two reasons, + both confirmed by reading lectio's own source + (cmd/lectio-ef-dump/main.go's doc comment): first, lectio prints week + "0" (rendered "-") "where no season week applies, e.g. named I class + feasts and per annum green-season ferias" -- an internal DISPLAY + convention of lectio's, not a liturgical fact, so there is nothing to + cross-check it against. Second, even where both sides print a real + number, the two engines anchor Time-after-Epiphany week numbering + differently (colitur: the first Sunday on/after Epiphany; lectio: a + fixed offset from 6 January -- register §3c item 5) and the offset + between them is NOT constant (it depends on which weekday 6 January + falls on, and re-synchronises mid-season), so no clean formula-based + check is possible without reimplementing lectio's own algorithm here. + Slug identity, rank and colour -- where the real liturgical substance + lives -- remain fully and separately compared; only the bare integer + is out of scope. See the report for the concrete rows this weakens. + + *** THE THREE-LAYER DESIGN (controller ruling, Task 15 dispatch) *** + + Of 16801 day-pairs (2005-2050), 11206 already match on the seven columns. + Of the 5595 that don't, exactly 25 distinct (field-diff) signatures cover + all of them (task-15-class-summary.txt). They resolve into three strictly + separate layers: + + - Layer A (this file's [norm_season]/[norm_slug]): vocabulary. A + declarative, explicit, closed table of naming synonyms that carry no + liturgical substance -- lectio's "easter"/"christmas" ARE colitur's + "paschaltide"/"christmastide"; a handful of slugs are two different + engines' names for the identical office (Christmas Vigil, Holy Name + Sunday, the Pentecost-octave Ember days, the two Passiontide weeks). + Every entry is a literal string pair, never a pattern -- widening this + to a wildcard is exactly how a real bug would get hidden, so it is not + done even where it would shorten the table. + + - Layer B ([strip_epiphany_index]): numbering. The ONE case in the whole + 5595 where a slug's embedded index genuinely cannot be reconciled by a + literal table (Time-after-Epiphany's non-constant offset, limit 3 + above) -- both sides' embedded week digit is stripped to a common + family+weekday form before comparing, while rank and colour (which + carry no week-index information for an ordinary green-season + feria/Sunday) remain fully compared, so a genuine identity bug in this + family would still be caught by everything except the digit itself. + + - Layer C (data/ef/expected-divergences.sexp, matched by + [layer_c_reason] below): the CITED allow-list. Eleven genuine liturgical + disagreements (C11 added by Task 16's oracle work, below), each citing + its RG paragraph and stating which engine is right (always colitur, + verified against the Missal/register, never against lectio's own + behaviour -- "lectio does it differently" is not itself a justification + anywhere in this file). This is the ONLY layer that may cover a + difference in rank, colour, or which celebration is observed; A and B + never do (enforced structurally below: A/B only ever + touch the season/slug fields, and Layer C's predicates each require an + exact, narrow field-diff SET, not "anything goes"). + + 13 January (register §6's long-open "Baptism of the Lord" item) is + EMPIRICALLY CONFIRMED FIXED, not allow-listed: colitur's slug/rank/colour + for 13 January already equal lectio's exactly, in all 46 years (the + sanctoral wiring landed in Task 11's "13 Jan now resolves to the Baptism + of the Lord" review note). The only residual difference there is season + (covered by Layer C's C1, the Jan 6-13 boundary) -- see the report. *) + +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 V = Rite_ef.Vocab_ef + +(* Same relative paths test_rite_ef.ml/test_sanctoral_ef.ml use: dune test + runs from _build/default/test/. *) +let sanctoral_path = "../data/ef/sanctoral.sexp" +let adjustments_path = "../data/ef/adjustments.sexp" +let fixture_path = "fixtures/lectio-ef-2005-2050.txt" +let allow_list_path = "../data/ef/expected-divergences.sexp" + +(* The fixture's own provenance note (test/fixtures/lectio-ef-2005-2050.provenance) + records this same digest, so it is discoverable by a reader who never runs + the suite. Recorded here too, and ASSERTED (fix round 1, finding 4): a + provenance note is enough to REGENERATE the fixture but says nothing about + whether the committed bytes still match the commit they claim to come + from -- an unnoticed hand-edit or partial re-copy would silently turn the + whole oracle into an unlabelled snapshot of whatever someone last ran. + Regenerate this constant (and the provenance note's copy) together, + deliberately, after re-running the exact command the provenance note + names -- never by copying the actual value back in to make a mismatch + pass, which would defeat the point of pinning it at all. *) +let fixture_sha256 = "2ca3eeeda4e7a0406c4d004c1b2003fc0df671aca9af18a1b506543a721c8bac" + +(* Same technique tools/bootstrap_sanctoral.ml already uses for this exact + purpose (that file's own comment: shelling out to the system's + [sha256sum], not an OCaml crypto library -- Task 15's deps are frozen). + Unlike that tool, this avoids even the (already-permitted, per that + file's own comment, "already in the switch") [unix] library: [Sys.command] + plus a redirected-to-file capture needs nothing beyond the Stdlib every + dune executable already links. Depends on [sha256sum] being on PATH, + which every environment this suite has actually run in (Debian, per + CLAUDE.md) provides via coreutils; a machine without it fails this check + with a command-not-found exit code rather than silently skipping it. *) +let sha256_of_file path = + let tmp = Filename.temp_file "colitur_differential_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 + +(* --- The seven-column row both streams share (commemorations excluded, --- *) +(* limit 1 above). *) +type row = { + date : string; + weekday : string; + season : string; + week : string; + slug : string; + rank : string; + colour : string; +} + +let read_lines path = + let ic = open_in path in + let rec loop acc = + match input_line ic with + | line -> loop (line :: acc) + | exception End_of_file -> + close_in ic; + List.rev acc + in + loop [] + +let row_of_line line = + match String.split_on_char ' ' line with + | date :: weekday :: season :: week :: slug :: rank :: colour :: _others -> + { date; weekday; season; week; slug; rank; colour } + | _ -> Alcotest.failf "malformed fixture line (fewer than 7 fields): %S" line + +let lectio_rows () = List.map row_of_line (read_lines fixture_path) + +(* Recomputes colitur's day-by-day output straight from the library -- + exactly [Colitur_kernel.Calendar.year] + [Rite_ef.context] over the real + committed data, the same pipeline bin/main.ml's `colitur day` runs (that + file's own [day_report]/[day_line] comments explain the two-liturgical- + year-per-civil-year indexing this mirrors). Duplicated here rather than + shared with bin/main.ml (an executable, not a library) -- the same choice + test_rite_ef.ml already made for [real_layer] above. *) +let colitur_rows_2005_2050 () = + let layer = real_layer () in + let by_rata : (int, (V.season, V.rank) LD.t) Hashtbl.t = Hashtbl.create 20000 in + for y = 2004 to 2050 do + let days = Cal.year Rite_ef.context 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 + for y = 2005 to 2050 do + let d = ref (mk y 1 1) in + let stop = mk y 12 31 in + while Date.compare !d stop <= 0 do + (match Hashtbl.find_opt by_rata (Date.to_rata !d) with + | Some day -> + let t = day.LD.temporal in + let cel = day.LD.observed in + let week = + match t.Colitur_kernel.Temporal.week with Some n -> string_of_int n | None -> "-" + in + rows := + { date = Date.to_iso8601 day.LD.date; + weekday = Date.weekday_to_string t.Colitur_kernel.Temporal.weekday; + season = V.season_to_string t.Colitur_kernel.Temporal.season; + week; + slug = Slug.to_string cel.Cel.slug; + rank = V.rank_to_string cel.Cel.rank; + colour = Colour.to_string cel.Cel.colour + } + :: !rows + | None -> Alcotest.failf "internal error: no resolved day for %s" (Date.to_iso8601 !d)); + d := Date.add_days !d 1 + done + done; + List.rev !rows + +(* ---------------------------------------------------------------------- *) +(* Layer A: vocabulary. Explicit, closed tables; no wildcards, no pattern *) +(* matching against arbitrary content -- every case below is a literal *) +(* string compared against a literal string. *) +(* ---------------------------------------------------------------------- *) + +(* lectio's season word -> colitur's season word. The ONLY two seasons that + are spelled differently; every other season word is shared verbatim + (both call Advent "advent", Lent "lent", etc.). *) +let norm_season = function + | "easter" -> "paschaltide" + | "christmas" -> "christmastide" + | s -> s + +let weekdays = [ "monday"; "tuesday"; "wednesday"; "thursday"; "friday"; "saturday" ] + +(* lectio's slug -> the colitur slug for the SAME office, where the two + projects simply chose different names. [month]/[lectio_rank] disambiguate + the two cases where lectio reuses one slug for what colitur names two + different ways (see each branch's own comment). *) +let rec norm_slug ~month ~lectio_rank slug = + if String.equal slug "vigil-of-christmas" then "ef-nativity-vigil" + (* register §6: lectio names its vigils "vigil-of-X" (prefix); colitur's + own convention is "X-vigil" (suffix). Same celebration -- confirmed a + genuine duplicate in Task 11, where colitur's overlay suppresses + lectio's key entirely from the sanctoral layer. *) + else if + (* "ef-christmas-sunday-0"/"ef-christmas-0-<weekday>" mean TWO different + things in lectio depending on which window they fall in: the Sunday + within Holy Name week (2-5 January, colitur's own named feast) or an + ordinary day within the Nativity Octave (26-31 December, where colitur + uses its own ef-nativity-octave-day-N naming instead, Layer C's C6 -- + that window keeps a genuine RANK difference too, so it must not be + absorbed here). Gating on [month = 1] keeps this table from ever + touching the December occurrence. *) + month = 1 + then + if String.equal slug "ef-christmas-sunday-0" then "ef-holy-name-sunday" + else + match List.find_opt (fun wd -> String.equal slug ("ef-christmas-0-" ^ wd)) weekdays with + | Some wd -> "ef-christmas-1-" ^ wd + | None -> norm_slug_rest ~lectio_rank slug + else norm_slug_rest ~lectio_rank slug + +and norm_slug_rest ~lectio_rank slug = + (* Passiontide: lectio never distinguishes Passion week (colitur's week 1, + class-3 ferias) from Holy week (colitur's week 2, class-1 ferias) in the + slug -- both print "ef-passiontide-0-<weekday>". Rank, independently and + strictly compared elsewhere, is what actually tells the two weeks apart + (RG 91 entries 22 vs 2/7), so using it here to pick the expected colitur + digit does not launder away a genuine identity bug: a colitur bug that + mixed up the two weeks would, on the evidence available in this stream, + also very likely show up as a rank mismatch of its own. *) + match List.find_opt (fun wd -> String.equal slug ("ef-passiontide-0-" ^ wd)) weekdays with + | Some wd -> ( + match lectio_rank with + | "class-3" -> "ef-passiontide-1-" ^ wd + | "class-1" -> "ef-passiontide-2-" ^ wd + | _ -> slug) + | None -> ( + match slug with + | "ef-easter-8-wednesday" -> "ef-pentecost-ember-wed" + | "ef-easter-8-friday" -> "ef-pentecost-ember-fri" + | "ef-easter-8-saturday" -> "ef-pentecost-ember-sat" + | s -> s) + +(* ---------------------------------------------------------------------- *) +(* Layer B: numbering (register §3c item 5). The Time-after-Epiphany *) +(* week-index embedded in a slug is stripped to a common form on BOTH *) +(* sides before comparing -- see limit 3 in this file's header comment *) +(* for why a table (Layer A's tool) cannot do this instead. *) +(* ---------------------------------------------------------------------- *) + +let starts_with ~prefix s = + let lp = String.length prefix in + String.length s >= lp && String.equal (String.sub s 0 lp) prefix + +let is_digit_string s = s <> "" && String.for_all (fun c -> c >= '0' && c <= '9') s + +let strip_epiphany_index slug = + let prefix = "ef-time-after-epiphany-" in + if not (starts_with ~prefix slug) then slug + else + let rest = String.sub slug (String.length prefix) (String.length slug - String.length prefix) in + match String.index_opt rest '-' with + | None -> slug + | Some i -> + let left = String.sub rest 0 i in + let right = String.sub rest (i + 1) (String.length rest - i - 1) in + if is_digit_string left && List.mem right weekdays then prefix ^ right + else if String.equal left "sunday" && is_digit_string right then prefix ^ "sunday" + else slug + +(* ---------------------------------------------------------------------- *) +(* Field-diff computation: applies Layers A and B, then reports exactly *) +(* which of the FIVE substantive columns still differ (week is never *) +(* inspected at all -- limit 3). weekday is included defensively: dates *) +(* are checked 1:1 aligned before this runs, so it should never fire, and *) +(* if it ever does that is real signal, not noise to normalise away. *) +(* ---------------------------------------------------------------------- *) + +type field = Weekday | Season | Slug_f | Rank | Colour_f + +let field_name = function + | Weekday -> "weekday" + | Season -> "season" + | Slug_f -> "slug" + | Rank -> "rank" + | Colour_f -> "colour" + +let month_of_date date = int_of_string (String.sub date 5 2) + +let diff_fields (l : row) (c : row) = + let m = month_of_date l.date in + let l_season = norm_season l.season in + let l_slug = strip_epiphany_index (norm_slug ~month:m ~lectio_rank:l.rank l.slug) in + let c_slug = strip_epiphany_index c.slug in + List.filter_map + (fun x -> x) + [ (if String.equal l.weekday c.weekday then None else Some Weekday); + (if String.equal l_season c.season then None else Some Season); + (if String.equal l_slug c_slug then None else Some Slug_f); + (if String.equal l.rank c.rank then None else Some Rank); + (if String.equal l.colour c.colour then None else Some Colour_f) + ] + +(* ---------------------------------------------------------------------- *) +(* Layer C: the cited allow-list (data/ef/expected-divergences.sexp). *) +(* Each predicate below names the [id] it matches; the sexp file carries *) +(* that id's citation, verdict and expected row count. A predicate fires *) +(* only on an EXACT, narrow field-diff set -- never "any difference at *) +(* all" -- so it cannot silently absorb a difference outside what its own *) +(* citation actually explains. *) +(* ---------------------------------------------------------------------- *) + +let subset xs ys = List.for_all (fun x -> List.mem x ys) xs +let day_of_date date = int_of_string (String.sub date 8 2) + +let advent_feria_slug slug = + List.exists + (fun wk -> List.exists (fun wd -> String.equal slug (Printf.sprintf "ef-advent-%d-%s" wk wd)) weekdays) + [ 3; 4 ] + +let sunday_iclass_slugs = + [ "ef-advent-sunday-2"; "ef-advent-sunday-4"; "ef-lent-sunday-1"; "ef-lent-sunday-2"; "ef-lent-sunday-3" ] + +let rose_sunday_slugs = [ "ef-advent-sunday-3"; "ef-lent-sunday-4" ] + +(* Fix round 1, finding 1: C1 and C6 (below) originally gated on calendar + date alone, with no slug/slug-family check -- unlike every other entry + here. The reviewer constructed the failure this leaves open: if a future + sanctoral regeneration made some OTHER 29-31 December celebration win the + day (colliding coincidentally with C6's own [Slug_f; Rank] diff shape), + it would be silently absorbed under "RG 91 entry 17, Nativity Octave" -- + a citation that has nothing to do with the real cause. [subset diffs + [...]] alone was never enough; the SLUG that actually won must also be + the one each citation is about. Both lists below are exact literals (the + Nativity Octave's three colitur-only day slugs; the closed set of + offices that can legitimately observe C1's Jan 6-13 window), not + patterns -- a slug outside them fails through to [None] instead of being + absorbed. *) +let jan_6_13_slug slug = + String.equal slug "ef-epiphany" + || String.equal slug "commemoration-of-the-baptism-of-the-lord" + || List.exists (fun wd -> String.equal slug ("ef-christmas-2-" ^ wd)) weekdays + +let nativity_octave_day_slugs = + [ "ef-nativity-octave-day-5"; "ef-nativity-octave-day-6"; "ef-nativity-octave-day-7" ] + +(* [layer_c_reason l c diffs] returns the [data/ef/expected-divergences.sexp] + [id] this row-pair's remaining (post Layer A/B) diff set belongs to, or + [None] if nothing here explains it (a genuine, uncovered failure). *) +let layer_c_reason (l : row) (c : row) diffs = + let m = month_of_date l.date and d = day_of_date l.date in + if diffs = [] then None + else if + m = 1 && d >= 6 && d <= 13 + && subset diffs [ Season; Colour_f; Slug_f ] + && (not (List.mem Slug_f diffs) || jan_6_13_slug c.slug) + then Some "C1" + else if List.mem c.slug sunday_iclass_slugs && diffs = [ Rank ] then Some "C2" + else if List.mem c.slug rose_sunday_slugs && subset diffs [ Rank; Colour_f ] then Some "C3" + else if advent_feria_slug c.slug && diffs = [ Rank ] then Some "C4" + else if starts_with ~prefix:"ef-lent-ember-" c.slug && subset diffs [ Slug_f; Rank ] then Some "C5" + else if + m = 12 + && (d = 29 || d = 30 || d = 31) + && subset diffs [ Slug_f; Rank ] + && (not (List.mem Slug_f diffs) || List.mem c.slug nativity_octave_day_slugs) + then Some "C6" + else if (String.equal c.slug "matthew" || String.equal c.slug "thomas") && subset diffs [ Slug_f; Colour_f ] + then Some "C7" + else if + (String.equal c.slug "ef-rogation-monday" || String.equal c.slug "ef-rogation-tuesday") + && subset diffs [ Season; Slug_f; Colour_f ] + then Some "C8" + else if + (String.equal l.slug "joseph-spouse-of-the-bl-virgin-mary" + || String.equal c.slug "joseph-spouse-of-the-bl-virgin-mary") + && subset diffs [ Season; Slug_f; Rank; Colour_f ] + then Some "C9" + else if + (String.equal l.date "2011-07-02" || String.equal l.date "2011-07-04") + && subset diffs [ Slug_f; Rank; Colour_f ] + then Some "C10" + else if String.equal c.slug "ef-passiontide-2-thursday" && diffs = [ Colour_f ] then Some "C11" + else None + +(* ---------------------------------------------------------------------- *) +(* data/ef/expected-divergences.sexp loading -- a plain sequence of *) +(* top-level records (not one wrapping list: see the file's own header). *) +(* ---------------------------------------------------------------------- *) + +open Sexplib0.Sexp_conv + +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 + +(* ---------------------------------------------------------------------- *) +(* The comparison itself, run once and shared by every test case below *) +(* (Alcotest test cases are independent processes-in-a-list, not free to *) +(* share mutable state across a suite, so this recomputes per call -- *) +(* acceptable: colitur's own 1583-9999 property sweep runs orders of *) +(* magnitude more days in tens of seconds, and this is 16801 civil days, *) +(* once per test case, twice total). *) +(* ---------------------------------------------------------------------- *) + +type outcome = Matched | Explained of string | Unexplained of field list + +let compare_streams () = + let lectio = lectio_rows () in + let colitur = colitur_rows_2005_2050 () in + (lectio, colitur) + +let classify lectio colitur = + List.map2 + (fun (l : row) (c : row) -> + if not (String.equal l.date c.date) then + Alcotest.failf "streams misaligned: lectio %s vs colitur %s" l.date c.date; + let diffs = diff_fields l c in + if diffs = [] then (l, c, Matched) + else + match layer_c_reason l c diffs with + | Some id -> (l, c, Explained id) + | None -> (l, c, Unexplained diffs)) + lectio colitur + +let describe_unexplained (l : row) (c : row) diffs = + Printf.sprintf "%s: %s differ -- lectio=(%s %s %s %s %s) colitur=(%s %s %s %s %s)" l.date + (String.concat "," (List.map field_name diffs)) + l.weekday l.season l.slug l.rank l.colour c.weekday c.season c.slug c.rank c.colour + +(* Fix round 1, finding 4: the fixture's own byte content must still match + the SHA-256 its provenance note claims (lectio commit 2386a45, recorded + both here and in test/fixtures/lectio-ef-2005-2050.provenance). Checked + before anything else reads the fixture -- a drifted fixture makes every + other assertion in this suite a statement about an unlabelled snapshot, + not about the pinned lectio commit it claims to be. *) +let test_fixture_checksum () = + Alcotest.(check string) "fixture SHA-256 matches its provenance note" fixture_sha256 + (sha256_of_file fixture_path) + +(* Dates align 1:1 in the same order on both streams (both are one line per + civil day, 2005-01-01..2050-12-31 -- see the fixture's own provenance + note and [colitur_rows_2005_2050]'s construction). A silent misalignment + would make every subsequent comparison meaningless -- checked first, on + its own, rather than trusted. *) +let test_dates_align () = + let lectio, colitur = compare_streams () in + Alcotest.(check int) "both streams have 16801 rows (46*365 + 11 leap days)" 16801 (List.length lectio); + Alcotest.(check int) "colitur recomputed the same number of rows" (List.length lectio) (List.length colitur); + let mismatched = + List.filter_map + (fun (l, c) -> if String.equal l.date c.date then None else Some (l.date, c.date)) + (List.combine lectio colitur) + in + Alcotest.(check (list (pair string string))) "no misaligned dates" [] mismatched + +(* The core assertion: every one of the 5595 raw differences is either + normalised away (Layers A/B) or named in the cited allow-list (Layer C). + Nothing else is permitted to pass silently. *) +let test_no_unexplained_differences () = + let lectio, colitur = compare_streams () in + let classified = classify lectio colitur in + let unexplained = + List.filter_map + (fun (l, c, outcome) -> + match outcome with Unexplained diffs -> Some (describe_unexplained l c diffs) | _ -> None) + classified + in + Alcotest.(check (list string)) "no differences outside Layers A/B/C" [] unexplained + +(* Teeth, not just green: EVERY Layer C entry's actual row count over this + fixture must equal what data/ef/expected-divergences.sexp declares, in + BOTH directions -- an id used by [layer_c_reason] that is missing from + the sexp file, an id declared but never matched, or a count that has + drifted either up or down, all fail loudly. A silent drift here is + exactly the "allow-list absorbs a new bug" failure mode this task was + warned about. *) +let test_layer_c_counts_match_citations () = + let lectio, colitur = compare_streams () in + let classified = classify lectio colitur in + let actual_counts = Hashtbl.create 16 in + List.iter + (fun (_, _, outcome) -> + match outcome with + | Explained id -> + Hashtbl.replace actual_counts id (1 + Option.value ~default:0 (Hashtbl.find_opt actual_counts id)) + | _ -> ()) + classified; + let declared = load_allow_list () in + let expected = + List.sort compare (List.map (fun e -> (e.id, e.expected_rows)) declared) + in + let actual = + List.sort compare + (Hashtbl.fold (fun id n acc -> (id, n) :: acc) actual_counts []) + in + Alcotest.(check (list (pair string int))) + "every allow-list id's actual row count matches its citation's expected_rows, and no id is unused or \ + undeclared" + expected actual + +let suite = + ( "differential (lectio, EF, 2005-2050)", + [ Alcotest.test_case "fixture SHA-256 matches its provenance note" `Quick test_fixture_checksum; + Alcotest.test_case "streams are 16801 rows each, dates aligned 1:1" `Quick test_dates_align; + Alcotest.test_case "every difference is normalised (A/B) or cited (C) -- none unexplained" `Quick + test_no_unexplained_differences; + Alcotest.test_case "Layer C counts match data/ef/expected-divergences.sexp exactly" `Quick + test_layer_c_counts_match_citations + ] ) |