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.

2 files changed, 39 insertions, 1 deletions

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)
diff --git a/test/test_lectionary.ml b/test/test_lectionary.ml
index 45a01ab..fba890a 100644
--- a/test/test_lectionary.ml
+++ b/test/test_lectionary.ml
@@ -53,8 +53,33 @@ let test_sexp_round_trip () =
   let l' = Lectionary.t_of_sexp (Lectionary.sexp_of_t l) in
   Alcotest.(check bool) "round trips" true (l = l')
 
+let with_temp_file contents f =
+  let path = Filename.temp_file "lectionary_test" ".sexp" in
+  let oc = open_out path in
+  output_string oc contents;
+  close_out oc;
+  Fun.protect ~finally:(fun () -> Sys.remove path) (fun () -> f path)
+
+let load_is_error contents what =
+  with_temp_file contents (fun path ->
+      match Lectionary.load path with
+      | Error _ -> ()
+      | Ok _ -> Alcotest.fail (what ^ ": expected Error, got Ok"))
+
+let test_load_never_raises () =
+  load_is_error "((ef-advent-sunday-1 (" "unterminated list";
+  load_is_error "((ef-advent-sunday-1 ((part First) (reference \"x" "unterminated string";
+  load_is_error "" "empty file";
+  load_is_error "() ()" "more than one sexp";
+  load_is_error "not-a-list" "wrong shape";
+  load_is_error "((\"NOT A SLUG\" ()))" "invalid slug";
+  match Lectionary.load "/nonexistent/path/lectionary.sexp" with
+  | Error _ -> ()
+  | Ok _ -> Alcotest.fail "missing file: expected Error, got Ok"
+
 let suite =
   [ ("find present", `Quick, test_find_present);
     ("find absent", `Quick, test_find_absent);
     ("duplicate slug rejected", `Quick, test_duplicate_slug_rejected);
-    ("sexp round-trip", `Quick, test_sexp_round_trip) ]
+    ("sexp round-trip", `Quick, test_sexp_round_trip);
+    ("load never raises", `Quick, test_load_never_raises) ]