diff options
Diffstat (limited to 'test')
| -rw-r--r-- | test/test_overlay.ml | 103 |
1 files changed, 97 insertions, 6 deletions
diff --git a/test/test_overlay.ml b/test/test_overlay.ml index 1b42eaf..6131f65 100644 --- a/test/test_overlay.ml +++ b/test/test_overlay.ml @@ -8,12 +8,12 @@ type rank = Class1 | Class3 [@@deriving sexp] let slug = S.of_string_exn -let cel ?(rank = Class3) ?(colour = Col.White) s = - Cel.make ~slug:(slug s) ~rank ~colour ~layer:"base" () +let cel ?(rank = Class3) ?(colour = Col.White) ?subject ?names ?citations s = + Cel.make ~slug:(slug s) ~rank ~colour ?subject ?names ?citations ~layer:"base" () -let entry ?(month = 1) ?(day = 1) ?rank ?colour s = +let entry ?(month = 1) ?(day = 1) ?rank ?colour ?subject ?names ?citations s = { L.date = (match DS.fixed ~month ~day with Ok d -> d | Error e -> failwith e); - cel = cel ?rank ?colour s } + cel = cel ?rank ?colour ?subject ?names ?citations s } let base () = L.of_entries ~id:"base" ~name:"Test base" @@ -115,6 +115,7 @@ module O = Colitur_kernel.Overlay module N = Colitur_kernel.Names module Lang = Colitur_kernel.Lang module Cit = Colitur_kernel.Citation +module Subj = Colitur_kernel.Subject let ov id directives = { O.id; directives } @@ -161,17 +162,91 @@ let test_last_writer_wins () = in Alcotest.(check bool) "second edit wins" true (rank_of l' "hilary" = Some Class3) +let test_replace () = + let l = base () in + (* Replace on an existing slug: the entry is swapped, no diagnostic. *) + let l', diags = + O.apply l (ov "o" [ O.Replace (slug "hilary", entry ~month:1 ~day:14 ~rank:Class1 "hilary") ]) + in + Alcotest.(check int) "no diagnostic when slug present" 0 (List.length diags); + Alcotest.(check bool) "entry replaced" true (rank_of l' "hilary" = Some Class1); + (* Replace on an absent slug: diagnostic recorded, but the entry is still + added -- an overlay must survive a shifted base, not just complain. *) + let l'', diags' = + O.apply l (ov "o" [ O.Replace (slug "candlemas", entry ~month:2 ~day:2 "candlemas") ]) + in + Alcotest.(check int) "one diagnostic when slug absent" 1 (List.length diags'); + Alcotest.(check bool) "entry added anyway" true (L.mem l'' (slug "candlemas")) + +let test_edit_set_subject () = + let l = base () in + let before = match L.find l (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in + let l', _ = O.apply l (ov "o" [ O.Edit (slug "hilary", [ O.Set_subject Subj.Saint ]) ]) in + let after = match L.find l' (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in + Alcotest.(check bool) "subject changed" true (after.L.cel.Cel.subject = Subj.Saint); + Alcotest.(check bool) "every other field untouched" true + ({ after with L.cel = { after.L.cel with Cel.subject = before.L.cel.Cel.subject } } = before) + +let test_edit_names () = + let en = Lang.of_string_exn "en" and pl = Lang.of_string_exn "pl" in + let l = + L.of_entries ~id:"base" ~name:"Test names" + [ entry ~month:1 ~day:14 ~names:(N.of_list [ (en, "Hilary of Poitiers") ]) "hilary" ] + in + let l', _ = O.apply l (ov "o" [ O.Edit (slug "hilary", [ O.Set_name (pl, "Hilary z Poitiers") ]) ]) in + let after_set = match L.find l' (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in + Alcotest.(check bool) "existing language untouched by set" true + (N.find after_set.L.cel.Cel.names en = Some "Hilary of Poitiers"); + Alcotest.(check bool) "new language added" true + (N.find after_set.L.cel.Cel.names pl = Some "Hilary z Poitiers"); + let l'', _ = O.apply l' (ov "o" [ O.Edit (slug "hilary", [ O.Remove_name en ]) ]) in + let after_remove = match L.find l'' (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in + Alcotest.(check bool) "removed language gone" true (N.find after_remove.L.cel.Cel.names en = None); + Alcotest.(check bool) "other language survives removal" true + (N.find after_remove.L.cel.Cel.names pl = Some "Hilary z Poitiers") + +let test_edit_citations () = + let existing = + [ { Cit.part = Cit.Gospel; reference = "Mt 1:1" }; { Cit.part = Cit.First; reference = "Is 1:1" } ] + in + let l = + L.of_entries ~id:"base" ~name:"Test citations" [ entry ~month:1 ~day:14 ~citations:existing "hilary" ] + in + (* Setting a part that already exists must replace it, not append a + duplicate -- the list length is the load-bearing check here. *) + let l', _ = O.apply l (ov "o" [ O.Edit (slug "hilary", [ O.Set_citation (Cit.Gospel, "Jn 3:16") ]) ]) in + let after_set = match L.find l' (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in + Alcotest.(check int) "still two citations, not three" 2 (List.length after_set.L.cel.Cel.citations); + Alcotest.(check bool) "gospel replaced" true + (List.exists + (fun c -> c.Cit.part = Cit.Gospel && c.Cit.reference = "Jn 3:16") + after_set.L.cel.Cel.citations); + Alcotest.(check bool) "first untouched by set" true + (List.exists (fun c -> c.Cit.part = Cit.First && c.Cit.reference = "Is 1:1") after_set.L.cel.Cel.citations); + let l'', _ = O.apply l' (ov "o" [ O.Edit (slug "hilary", [ O.Remove_citation Cit.Gospel ]) ]) in + let after_remove = match L.find l'' (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in + Alcotest.(check int) "one citation left" 1 (List.length after_remove.L.cel.Cel.citations); + Alcotest.(check bool) "first survives removal" true + (List.exists + (fun c -> c.Cit.part = Cit.First && c.Cit.reference = "Is 1:1") + after_remove.L.cel.Cel.citations) + let test_diagnostics () = let l = base () in + (* Add-over-existing uses a rank that genuinely differs from base()'s hilary + (Class3, the [entry] helper's own default) -- otherwise re-adding with + the default would leave [hilary] indistinguishable from doing nothing, + and [L.mem] alone cannot tell "replaced" from "left untouched". *) let _, diags = O.apply l (ov "o" [ O.Suppress (slug "nobody"); O.Edit (slug "nobody", [ O.Set_colour Col.Red ]); - O.Add (entry ~month:1 ~day:14 "hilary") ]) + O.Add (entry ~month:1 ~day:14 ~rank:Class1 "hilary") ]) in (* unknown suppress, unknown edit, and add-over-existing: three, none silent *) Alcotest.(check int) "three diagnostics" 3 (List.length diags); + let l', _ = O.apply l (ov "o" [ O.Add (entry ~month:1 ~day:14 ~rank:Class1 "hilary") ]) in Alcotest.(check bool) "add-over-existing still applied (last writer wins)" true - (L.mem (fst (O.apply l (ov "o" [ O.Add (entry ~month:1 ~day:14 "hilary") ]))) (slug "hilary")) + (rank_of l' "hilary" = Some Class1) let test_merge_order () = let l = base () in @@ -181,6 +256,17 @@ let test_merge_order () = in Alcotest.(check bool) "later overlay wins" true (rank_of l' "hilary" = Some Class3) +let test_merge_diagnostics () = + let l = base () in + let _, diags = + O.merge l + [ ov "a" [ O.Suppress (slug "nobody-a") ]; + ov "b" [ O.Edit (slug "nobody-b", [ O.Set_colour Col.Red ]) ] ] + in + Alcotest.(check int) "two diagnostics" 2 (List.length diags); + Alcotest.(check (list string)) "diagnostics in application order" [ "a"; "b" ] + (List.map (fun d -> d.O.overlay) diags) + let test_overlay_sexp () = let o = ov "o" [ O.Edit (slug "hilary", [ O.Set_colour Col.Red ]); O.Suppress (slug "telesphorus") ] in @@ -217,7 +303,12 @@ let suite = Alcotest.test_case "order matters" `Quick test_order_matters; Alcotest.test_case "edit is field-scoped" `Quick test_edit_is_field_scoped; Alcotest.test_case "last writer wins" `Quick test_last_writer_wins; + Alcotest.test_case "replace" `Quick test_replace; + Alcotest.test_case "edit sets subject" `Quick test_edit_set_subject; + Alcotest.test_case "edit sets and removes names" `Quick test_edit_names; + Alcotest.test_case "edit sets and removes citations" `Quick test_edit_citations; Alcotest.test_case "diagnostics" `Quick test_diagnostics; Alcotest.test_case "merge order" `Quick test_merge_order; + Alcotest.test_case "merge diagnostics" `Quick test_merge_diagnostics; Alcotest.test_case "overlay sexp" `Quick test_overlay_sexp ] @ List.map QCheck_alcotest.to_alcotest [ prop_deterministic ] ) |
