From 2c0187f42cc45864932aba2529f876be86ddba39 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Fri, 14 Aug 2026 16:52:29 +0200 Subject: kernel(lectionary): fix round 1 -- load never raises Sexplib.Sexp.load_sexp raises bare Failure for several malformed inputs (unterminated list/string, empty file, more than one sexp) rather than Sexplib.Sexp.Parse_error, so those cases escaped Lectionary.load as an uncaught exception -- breaking the .mli's own promise and the kernel's never-raises-on-fallible-construction constraint. Mirrors the catch-all already present in Layer.load and Overlay.load, plus a second catch-all on the t_of_sexp branch for defence in depth. Adds test_load_never_raises, covering all of the above plus a missing file, using Filename.temp_file rather than a hardcoded path. Verified the new test fails against the pre-fix load (uncaught Failure) and passes against the fix. --- lib/kernel/lectionary.ml | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'lib/kernel/lectionary.ml') diff --git a/lib/kernel/lectionary.ml b/lib/kernel/lectionary.ml index 1da3d1e..2d478e6 100644 --- a/lib/kernel/lectionary.ml +++ b/lib/kernel/lectionary.ml @@ -26,8 +26,21 @@ let load path = | exception Sexplib.Sexp.Parse_error e -> Error (Printf.sprintf "lectionary: %s: %s" path e.err_msg) | exception Sys_error e -> Error (Printf.sprintf "lectionary: %s" e) + (* Mirrors Layer.load/Overlay.load: this sexplib version raises [Failure] + for some malformed inputs (e.g. an unterminated list or string, an + empty file, or a file holding more than one sexp) rather than + [Sexplib.Sexp.Parse_error], so a catch-all here -- placed last among the + exception branches -- is what actually keeps every parse failure inside + [Error] instead of escaping. *) + | exception exn -> Error (Printf.sprintf "lectionary: %s: %s" path (Printexc.to_string exn)) | sexp -> ( match t_of_sexp sexp with | exception Sexplib0.Sexp_conv_error.Of_sexp_error (exn, _) -> Error (Printf.sprintf "lectionary: %s: %s" path (Printexc.to_string exn)) + (* Defence in depth: every conversion below is currently + [Of_sexp_error] (including [Slug.t_of_sexp] on a malformed slug + atom), but [t_of_sexp] is derived and could raise something else + after a future type change -- this catch-all is what would keep + that inside [Error] too, the same reasoning as the outer one above. *) + | exception exn -> Error (Printf.sprintf "lectionary: %s: %s" path (Printexc.to_string exn)) | parsed -> of_entries parsed) -- cgit v1.3