From ca289b2f43a5b097c4ec20308c1661a0c404399c Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 11:25:56 +0200 Subject: kernel: Slug and Lang validated private strings Both parse through a smart constructor returning result, and both hand-write t_of_sexp so a malformed value in a data file is rejected at load rather than silently accepted -- deriving the converter would have bypassed validation. --- test/test_slug.ml | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 test/test_slug.ml (limited to 'test/test_slug.ml') diff --git a/test/test_slug.ml b/test/test_slug.ml new file mode 100644 index 0000000..af70e9a --- /dev/null +++ b/test/test_slug.ml @@ -0,0 +1,39 @@ +module S = Colitur_kernel.Slug +module L = Colitur_kernel.Lang + +let ok_slug s = match S.of_string s with + | Ok t -> t | Error e -> Alcotest.failf "slug %S: %s" s e + +let test_slug_accepts () = + Alcotest.(check string) "plain" "ef-advent-sunday-1" (S.to_string (ok_slug "ef-advent-sunday-1")); + Alcotest.(check string) "digits" "ef-lent-3-monday" (S.to_string (ok_slug "ef-lent-3-monday")) + +let test_slug_rejects () = + List.iter + (fun bad -> + Alcotest.(check bool) (Printf.sprintf "reject %S" bad) true (Result.is_error (S.of_string bad))) + [ ""; "Ef-Advent"; "ef advent"; "ef_advent"; "-leading"; "trailing-"; "ef/advent" ] + +let test_slug_sexp () = + let s = ok_slug "ef-easter-sunday" in + Alcotest.(check bool) "roundtrip" true (S.equal (S.t_of_sexp (S.sexp_of_t s)) s); + (* A malformed slug in a data file must be rejected, not silently accepted. *) + Alcotest.check_raises "bad slug in sexp" + (Sexplib0.Sexp_conv_error.Of_sexp_error + (Failure "slug \"Bad Slug\": only [a-z0-9-] allowed", Sexplib0.Sexp.Atom "Bad Slug")) + (fun () -> ignore (S.t_of_sexp (Sexplib0.Sexp.Atom "Bad Slug"))) + +let test_lang () = + Alcotest.(check string) "la" "la" (L.to_string (match L.of_string "la" with + | Ok t -> t | Error e -> Alcotest.failf "%s" e)); + List.iter + (fun bad -> + Alcotest.(check bool) (Printf.sprintf "reject %S" bad) true (Result.is_error (L.of_string bad))) + [ ""; "e"; "eng"; "EN"; "e1" ] + +let suite = + ( "Slug/Lang", + [ Alcotest.test_case "slug accepts" `Quick test_slug_accepts; + Alcotest.test_case "slug rejects" `Quick test_slug_rejects; + Alcotest.test_case "slug sexp validates" `Quick test_slug_sexp; + Alcotest.test_case "lang" `Quick test_lang ] ) -- cgit v1.3