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_names.ml | 30 +++++++++++++++++++++++++++--- 1 file changed, 27 insertions(+), 3 deletions(-) (limited to 'test/test_names.ml') 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 ] ) -- cgit v1.3