summaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 16:21:46 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-11 16:21:46 +0200
commit745ec8f8edb32ee7ef0a8c12ab84833216296f73 (patch)
tree3ca4dc144b2448553923716fdf54d91526354446 /test
parent1203380c4644277a2949d42f4619360c1c0ef1e5 (diff)
downloadcolitur-745ec8f8edb32ee7ef0a8c12ab84833216296f73.tar.gz
colitur-745ec8f8edb32ee7ef0a8c12ab84833216296f73.zip
kernel: loaders never escape as an exception, date-spec validates on load
Layer.load narrowed its catch to Sexplib0.Sexp_conv_error.Of_sexp_error, but rank_of_sexp is caller-supplied and may raise anything -- e.g. a hand-written rank parser that calls invalid_arg. Overlay.load already catches every exception from the equivalent call; mirror that here so layer.mli's "never as an exception" promise actually holds. Date_spec.t derived its sexp converters with plain ppx_sexp_conv, unlike Slug and Lang, which hand-write validating parsers specifically so malformed data is rejected at load. (Fixed (month 13) (day 40)) used to deserialise cleanly into a spec that simply never resolves -- a saint quietly vanishing with no diagnostic. t_of_sexp now re-runs the value through the existing fixed validator, the same shape Slug and Lang already use. Covering tests: a Layer.load case where rank_of_sexp raises Invalid_argument instead of Of_sexp_error (would have escaped uncaught before this fix); two Date_spec.t_of_sexp cases (month 13, 31 April) that must raise Of_sexp_error rather than silently constructing an unresolvable spec.
Diffstat (limited to 'test')
-rw-r--r--test/test_names.ml30
-rw-r--r--test/test_overlay.ml19
2 files changed, 46 insertions, 3 deletions
diff --git a/test/test_names.ml b/test/test_names.ml
index 1649f9e..809d1c0 100644
--- a/test/test_names.ml
+++ b/test/test_names.ml
@@ -74,6 +74,24 @@ let test_date_spec_sexp_roundtrip () =
Alcotest.(check bool) "sexp roundtrip" true (ds = ds')
| Error e -> Alcotest.failf "fixed: %s" e)
+let test_date_spec_sexp_validates () =
+ (* Register finding 6: [ppx_sexp_conv]'s plain derived [t_of_sexp] would
+ accept any in-range int pair for [Fixed], so [(Fixed(month 13)(day 1))]
+ would silently deserialise into a spec that simply never resolves -- a
+ saint quietly vanishing with no diagnostic. [t_of_sexp] now re-runs the
+ value through [fixed], matching how [Slug] and [Lang] already validate
+ on load. *)
+ let bad = Sexplib.Sexp.of_string "(Fixed(month 13)(day 1))" in
+ Alcotest.check_raises "month 13 rejected at load"
+ (Sexplib0.Sexp_conv_error.Of_sexp_error
+ (Failure "date_spec: month 13 out of range 1..12", bad))
+ (fun () -> ignore (DS.t_of_sexp bad));
+ let bad_day = Sexplib.Sexp.of_string "(Fixed(month 4)(day 31))" in
+ Alcotest.check_raises "31 April rejected at load"
+ (Sexplib0.Sexp_conv_error.Of_sexp_error
+ (Failure "date_spec: day 31 out of range for month 4", bad_day))
+ (fun () -> ignore (DS.t_of_sexp bad_day))
+
module Cel = Colitur_kernel.Celebration
module S = Colitur_kernel.Slug
module Col = Colitur_kernel.Colour
@@ -135,9 +153,14 @@ let test_record () =
Alcotest.(check (list string)) "headers schema"
[ "date"; "rite"; "season"; "week"; "weekday"; "slug"; "rank"; "colour"; "subject" ]
Rec.headers;
- (* Row must be the same length and order as headers. *)
- Alcotest.(check int) "row matches headers length" (List.length Rec.headers)
- (List.length (Rec.to_row r))
+ (* Register finding 14: with headers and to_row both derived from the same
+ [columns] list, equal length holds by construction -- a length-only
+ check here is vacuous, since it cannot fail without headers and to_row
+ already being defined from different sources. Assert the row's actual
+ values, in header order, instead. *)
+ Alcotest.(check (list string)) "row values in header order"
+ [ "2026-04-05"; "ef"; "ordinary"; "1"; "sunday"; "ef-easter-sunday"; "high"; "white"; "lord" ]
+ (Rec.to_row r)
let suite =
( "Names/Citation/DateSpec",
@@ -149,5 +172,6 @@ let suite =
Alcotest.test_case "citation" `Quick test_citation;
Alcotest.test_case "date_spec" `Quick test_date_spec;
Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip;
+ Alcotest.test_case "date_spec sexp validates" `Quick test_date_spec_sexp_validates;
Alcotest.test_case "celebration" `Quick test_celebration;
Alcotest.test_case "record" `Quick test_record ] )
diff --git a/test/test_overlay.ml b/test/test_overlay.ml
index 6131f65..b5edd5a 100644
--- a/test/test_overlay.ml
+++ b/test/test_overlay.ml
@@ -111,6 +111,23 @@ let test_layer_load_invalid_slug () =
| Ok _ -> Alcotest.fail "expected Error for an invalid slug"
| Error _ -> ())
+let test_layer_load_rank_of_sexp_raises_other_exception () =
+ (* Register finding 7: [rank_of_sexp] is caller-supplied and may raise
+ anything, not only [Of_sexp_error] -- [layer.mli] promises "never as an
+ exception". Before the fix this call did not reach the [Ok]/[Error]
+ match at all: [Invalid_argument] escaped [L.load] uncaught, and this
+ test would have errored rather than exercised the [Error _ -> ()]
+ branch. *)
+ 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;
+ let exploding_rank_of_sexp _sexp = invalid_arg "boom" in
+ match L.load exploding_rank_of_sexp path with
+ | Ok _ -> Alcotest.fail "expected Error, not a successful load"
+ | Error _ -> ())
+
module O = Colitur_kernel.Overlay
module N = Colitur_kernel.Names
module Lang = Colitur_kernel.Lang
@@ -298,6 +315,8 @@ let suite =
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;
+ Alcotest.test_case "layer load: rank_of_sexp raises a non-Of_sexp_error exception" `Quick
+ test_layer_load_rank_of_sexp_raises_other_exception;
Alcotest.test_case "empty is identity" `Quick test_empty_is_identity;
Alcotest.test_case "add and suppress" `Quick test_add_and_suppress;
Alcotest.test_case "order matters" `Quick test_order_matters;