From 745ec8f8edb32ee7ef0a8c12ab84833216296f73 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 16:21:46 +0200 Subject: 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. --- test/test_overlay.ml | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) (limited to 'test/test_overlay.ml') 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; -- cgit v1.3