diff options
| -rw-r--r-- | test/test_overlay.ml | 81 |
1 files changed, 80 insertions, 1 deletions
diff --git a/test/test_overlay.ml b/test/test_overlay.ml index ece4069..b3a8f26 100644 --- a/test/test_overlay.ml +++ b/test/test_overlay.ml @@ -19,6 +19,24 @@ let base () = L.of_entries ~id:"base" ~name:"Test base" [ entry ~month:1 ~day:5 "telesphorus"; entry ~month:1 ~day:14 "hilary" ] +(* First occurrence only -- used to corrupt one field (the slug atom) of an + otherwise well-formed serialised layer, without hand-writing the whole + sexp shape by hand. *) +let replace_first ~sub ~by s = + let sub_len = String.length sub and s_len = String.length s in + let rec find i = + if i + sub_len > s_len then None + else if String.sub s i sub_len = sub then Some i + else find (i + 1) + in + match find 0 with + | None -> s + | Some i -> String.sub s 0 i ^ by ^ String.sub s (i + sub_len) (s_len - i - sub_len) + +let with_temp_file f = + let path = Filename.temp_file "colitur_layer" ".sexp" in + Fun.protect ~finally:(fun () -> try Sys.remove path with Sys_error _ -> ()) (fun () -> f path) + let test_layer_basics () = let l = base () in Alcotest.(check bool) "find present" true (L.find l (slug "hilary") <> None); @@ -33,13 +51,74 @@ let test_layer_index () = Alcotest.(check int) "Jan 14 has one" 1 (List.length (L.on_date idx ~month:1 ~day:14)); Alcotest.(check int) "Jan 20 has none" 0 (List.length (L.on_date idx ~month:1 ~day:20)) +(* Three entries sharing a date, inserted deliberately out of canonical + (by-slug) order: this is what actually pins accumulation (the bucket must + hold all three, not overwrite) and deterministic ordering (the bucket must + come back sorted regardless of insertion order). Entries already inserted + in sorted order would pass even with the sort dropped. *) +let test_layer_index_same_date () = + let l = + L.of_entries ~id:"base" ~name:"Test same-date" + [ entry ~month:3 ~day:17 "zeta"; entry ~month:3 ~day:17 "alpha"; entry ~month:3 ~day:17 "mu" ] + in + let idx = L.index_by_date l in + let bucket = L.on_date idx ~month:3 ~day:17 in + Alcotest.(check int) "three entries share Mar 17" 3 (List.length bucket); + Alcotest.(check (list string)) "bucket sorted by slug" [ "alpha"; "mu"; "zeta" ] + (List.map (fun e -> S.to_string e.L.cel.Cel.slug) bucket) + let test_layer_sexp () = let l = base () in let sexp = L.sexp_of_t sexp_of_rank l in Alcotest.(check bool) "roundtrip" true (L.t_of_sexp rank_of_sexp sexp = l) +let test_layer_load_success () = + let l = base () in + with_temp_file (fun path -> + let oc = open_out path in + output_string oc (Sexplib.Sexp.to_string (L.sexp_of_t sexp_of_rank l)); + close_out oc; + match L.load rank_of_sexp path with + | Ok loaded -> Alcotest.(check bool) "round-trip equal" true (loaded = l) + | Error msg -> Alcotest.failf "expected Ok, got Error %s" msg) + +let test_layer_load_missing_file () = + let path = Filename.temp_file "colitur_layer_missing" ".sexp" in + Sys.remove path; + match L.load rank_of_sexp path with + | Ok _ -> Alcotest.fail "expected Error for a missing file" + | Error _ -> () + +let test_layer_load_malformed () = + with_temp_file (fun path -> + let oc = open_out path in + (* unterminated list -- sexplib raises Failure here, not Parse_error *) + output_string oc "((id \"x\") (name \"y\") (entries ("; + close_out oc; + match L.load rank_of_sexp path with + | Ok _ -> Alcotest.fail "expected Error for a malformed sexp" + | Error _ -> ()) + +let test_layer_load_invalid_slug () = + let single = L.of_entries ~id:"base" ~name:"Test" [ entry ~month:2 ~day:2 "hilary" ] in + let text = Sexplib.Sexp.to_string (L.sexp_of_t sexp_of_rank single) in + let corrupted = replace_first ~sub:"hilary" ~by:"Bad_Slug!" text in + with_temp_file (fun path -> + let oc = open_out path in + output_string oc corrupted; + close_out oc; + match L.load rank_of_sexp path with + | Ok _ -> Alcotest.fail "expected Error for an invalid slug" + | Error _ -> ()) + let suite = ( "Layer/Overlay", [ Alcotest.test_case "layer basics" `Quick test_layer_basics; Alcotest.test_case "layer by-date index" `Quick test_layer_index; - Alcotest.test_case "layer sexp" `Quick test_layer_sexp ] ) + Alcotest.test_case "layer by-date index accumulates same date" `Quick + test_layer_index_same_date; + Alcotest.test_case "layer sexp" `Quick test_layer_sexp; + Alcotest.test_case "layer load success round-trip" `Quick test_layer_load_success; + Alcotest.test_case "layer load missing file" `Quick test_layer_load_missing_file; + Alcotest.test_case "layer load malformed sexp" `Quick test_layer_load_malformed; + Alcotest.test_case "layer load invalid slug" `Quick test_layer_load_invalid_slug ] ) |