aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
Diffstat (limited to 'test')
-rw-r--r--test/test_colitur.ml3
-rw-r--r--test/test_support.ml65
-rw-r--r--test/test_view.ml119
3 files changed, 186 insertions, 1 deletions
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index f12dab5..dadc77d 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -9,4 +9,5 @@ let () =
("lectionary-ef", Test_lectionary_ef.suite);
Test_escape.suite;
Test_template.suite;
- Test_template.render_suite ]
+ Test_template.render_suite;
+ Test_view.suite ]
diff --git a/test/test_support.ml b/test/test_support.ml
new file mode 100644
index 0000000..7d7662f
--- /dev/null
+++ b/test/test_support.ml
@@ -0,0 +1,65 @@
+(* Loaders for the real EF data (data/ef/*.sexp), extracted from
+ bin/main.ml's [load_ef_layer]/[load_ef_lectionary]/[load_ef_commons]
+ (bin/main.ml:154, :193, :206) and simplified to what the test suite
+ needs: no [~user_overlays], no COLITUR_DATA_DIR/installed-prefix
+ indirection (that machinery exists so the CLI finds its data next to
+ wherever it was installed or built -- tests always run from test/, where
+ test/dune already declares the four data/ef/*.sexp paths as [deps]).
+ Reading them via the same "../data/ef/..." relative paths test_calendar.ml,
+ test_rite_ef.ml and test_lectionary_ef.ml already use, not [bin/]'s own
+ [data_dir ()].
+
+ Deliberately NOT shared as a library with bin/main.ml: [bin/] and [test/]
+ are separate dune stanzas, and three small loaders duplicated here is
+ cheaper than a new library built just to serve them. bin/main.ml is not
+ changed to use this module -- the CLI keeps its own copy, already pinned
+ by test/cli.t. *)
+
+let sanctoral_path = "../data/ef/sanctoral.sexp"
+let adjustments_path = "../data/ef/adjustments.sexp"
+let lectionary_path = "../data/ef/lectionary.sexp"
+let commons_path = "../data/ef/commons.sexp"
+
+(* Mirrors bin/main.ml's [load_ef_layer]: the shipped sanctoral layer with
+ the shipped adjustments overlay merged on top (RG 110's 30 June
+ companion, the Major Litanies, Barbara, Rogation Wednesday -- see
+ adjustments.sexp's own header). No user overlays: the test suite always
+ wants the plain shipped calendar. Diagnostics are discarded rather than
+ surfaced -- the shipped overlay is asserted elsewhere (test_overlay.ml,
+ the "check" path) to merge clean; a test that wants to see them can
+ still call {!Colitur_kernel.Overlay.merge} directly. *)
+let load_ef_layer () =
+ match Colitur_kernel.Layer.load Rite_ef.Vocab_ef.rank_of_sexp sanctoral_path with
+ | Error e -> Error (Printf.sprintf "failed to load %s: %s" sanctoral_path e)
+ | Ok layer -> (
+ match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp adjustments_path with
+ | Error e -> Error (Printf.sprintf "failed to load %s: %s" adjustments_path e)
+ | Ok overlay ->
+ let layer, _diagnostics = Colitur_kernel.Overlay.merge layer [ overlay ] in
+ Ok layer)
+
+(* Mirrors bin/main.ml's [load_ef_lectionary]. *)
+let load_ef_lectionary () =
+ match Colitur_kernel.Lectionary.load lectionary_path with
+ | Error e -> Error (Printf.sprintf "failed to load %s: %s" lectionary_path e)
+ | Ok l -> Ok l
+
+(* Mirrors bin/main.ml's [load_ef_commons]. *)
+let load_ef_commons () =
+ match Rite_ef.Lectionary_ef.Commons.load commons_path with
+ | Error e -> Error (Printf.sprintf "failed to load %s: %s" commons_path e)
+ | Ok c -> Ok c
+
+(* Assembles [Rite_ef.context] the way bin/main.ml:328 does, over the real
+ shipped lectionary and Commons. Raises on a load failure rather than
+ returning a [result]: the four data files are declared [deps] in
+ test/dune, so a failure here means the test tree itself is broken, the
+ same condition test_calendar.ml's and test_rite_ef.ml's own
+ module-level loaders already treat as fatal. *)
+let ef_context () =
+ match load_ef_lectionary () with
+ | Error e -> failwith e
+ | Ok lectionary -> (
+ match load_ef_commons () with
+ | Error e -> failwith e
+ | Ok commons -> Rite_ef.context ~lectionary ~commons)
diff --git a/test/test_view.ml b/test/test_view.ml
new file mode 100644
index 0000000..e595357
--- /dev/null
+++ b/test/test_view.ml
@@ -0,0 +1,119 @@
+module V = Colitur_render.View
+module T = Colitur_render.Template
+
+(* Build one civil year of resolved days exactly as the CLI does. *)
+let days_of_year y =
+ let layer =
+ match Test_support.load_ef_layer () with Ok l -> l | Error e -> Alcotest.failf "layer: %s" e
+ in
+ let context = Test_support.ef_context () in
+ let module Cal = Colitur_kernel.Calendar in
+ let module D = Colitur_kernel.Date in
+ let tbl = Hashtbl.create 400 in
+ let index days =
+ Array.iter (fun d -> Hashtbl.replace tbl (D.to_rata d.Colitur_kernel.Liturgical_day.date) d) days
+ in
+ index (Cal.year context layer (y - 1));
+ index (Cal.year context layer y);
+ let jan1 = Result.get_ok (D.make ~year:y ~month:1 ~day:1) in
+ let dec31 = Result.get_ok (D.make ~year:y ~month:12 ~day:31) in
+ let out = ref [] and d = ref jan1 in
+ while D.compare !d dec31 <= 0 do
+ (match Hashtbl.find_opt tbl (D.to_rata !d) with Some x -> out := x :: !out | None -> ());
+ d := D.add_days !d 1
+ done;
+ List.rev !out
+
+let view_of y =
+ V.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y (days_of_year y)
+
+let get path v =
+ let rec go v = function
+ | [] -> v
+ | k :: tl -> (
+ match v with
+ | T.Obj kvs -> (
+ match List.assoc_opt k kvs with Some v' -> go v' tl | None -> Alcotest.failf "no key %s" k)
+ | _ -> Alcotest.failf "not an object at %s" k)
+ in
+ go v path
+
+let as_list = function T.List l -> l | _ -> Alcotest.fail "expected a list"
+let as_str = function T.Str s -> s | _ -> Alcotest.fail "expected a string"
+let as_bool = function T.Bool b -> b | _ -> Alcotest.fail "expected a bool"
+
+let test_year_shape () =
+ let v = view_of 2027 in
+ Alcotest.(check string) "rite" "ef" (as_str (get [ "rite" ] v));
+ Alcotest.(check string) "year" "2027" (as_str (get [ "year" ] v));
+ Alcotest.(check int) "twelve months" 12 (List.length (as_list (get [ "months" ] v)));
+ Alcotest.(check int) "365 days" 365 (List.length (as_list (get [ "days" ] v)))
+
+(* THE property the grid depends on: weeks flatten to the month's days plus
+ padding, and every real day appears exactly once (spec section 9.3). *)
+let test_weeks_flatten_to_days () =
+ let v = view_of 2027 in
+ List.iter
+ (fun m ->
+ let weeks = as_list (get [ "weeks" ] m) in
+ let cells = List.concat_map (fun w -> as_list (get [ "days" ] w)) weeks in
+ List.iter
+ (fun w -> Alcotest.(check int) "seven cells per week" 7 (List.length (as_list (get [ "days" ] w))))
+ weeks;
+ let real = List.filter (fun c -> as_bool (get [ "in_month" ] c)) cells in
+ let own = as_list (get [ "days" ] m) in
+ Alcotest.(check int) "real cells = month days" (List.length own) (List.length real);
+ List.iter2
+ (fun a b -> Alcotest.(check string) "same day, same order" (as_str (get [ "iso" ] a)) (as_str (get [ "iso" ] b)))
+ own real)
+ (as_list (get [ "months" ] v))
+
+let test_padding_cells_are_flagged () =
+ let v = view_of 2027 in
+ let jan = List.hd (as_list (get [ "months" ] v)) in
+ let first_week = List.hd (as_list (get [ "weeks" ] jan)) in
+ let cells = as_list (get [ "days" ] first_week) in
+ (* 1 January 2027 is a Friday, so the first week has five padding cells. *)
+ Alcotest.(check int) "five padding cells" 5
+ (List.length (List.filter (fun c -> not (as_bool (get [ "in_month" ] c))) cells));
+ List.iter
+ (fun c ->
+ if not (as_bool (get [ "in_month" ] c)) then
+ Alcotest.(check string) "padding has empty iso" "" (as_str (get [ "iso" ] c)))
+ cells
+
+let test_day_fields () =
+ let v = view_of 2027 in
+ let d =
+ List.find (fun d -> as_str (get [ "iso" ] d) = "2027-01-13") (as_list (get [ "days" ] v))
+ in
+ Alcotest.(check string) "slug" "commemoration-of-the-baptism-of-the-lord" (as_str (get [ "slug" ] d));
+ Alcotest.(check string) "colour" "white" (as_str (get [ "colour" ] d));
+ Alcotest.(check bool) "is_white" true (as_bool (get [ "is_white" ] d));
+ Alcotest.(check bool) "is_violet" false (as_bool (get [ "is_violet" ] d));
+ Alcotest.(check int) "dow friday" 3 (int_of_string (as_str (get [ "dow" ] d)));
+ Alcotest.(check bool) "first citation present" true (as_str (get [ "first" ] d) <> "");
+ Alcotest.(check bool) "gospel citation present" true (as_str (get [ "gospel" ] d) <> "")
+
+(* Exactly one of the six colour booleans is true on every day of a whole year:
+ a template that keys a cell colour off them can never get no colour or two. *)
+let test_exactly_one_colour_flag () =
+ let v = view_of 2027 in
+ List.iter
+ (fun d ->
+ let n =
+ List.length
+ (List.filter
+ (fun k -> as_bool (get [ k ] d))
+ [ "is_white"; "is_red"; "is_green"; "is_violet"; "is_rose"; "is_black" ])
+ in
+ if n <> 1 then Alcotest.failf "%s has %d colour flags set" (as_str (get [ "iso" ] d)) n)
+ (as_list (get [ "days" ] v))
+
+let suite =
+ ( "View",
+ [ Alcotest.test_case "year shape" `Quick test_year_shape;
+ Alcotest.test_case "weeks flatten to days" `Quick test_weeks_flatten_to_days;
+ Alcotest.test_case "padding cells flagged" `Quick test_padding_cells_are_flagged;
+ Alcotest.test_case "day fields" `Quick test_day_fields;
+ Alcotest.test_case "exactly one colour flag" `Quick test_exactly_one_colour_flag ] )
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 16:15:11 +0000