Fix test suite.

mefyl · Apr 3, 2023 · db1f63a · db1f63a
1 parent 48ee168
commit db1f63a
Show file tree

Hide file tree

Showing 2 changed files with 52 additions and 39 deletions.
diff --git a/timmy/tests/schemas.schematic.ml b/timmy/tests/schemas.schematic.ml
@@ -26,6 +26,8 @@ let json () =
   in
   ()
 
+[@@@warning "-fragile-literal-pattern"]
+
 let daytime () =
   let () =
     roundtrip ~here:[%here] daytime Timmy.Daytime.schema
@@ -36,27 +38,32 @@ let daytime () =
           ("hours", `Float 13.); ("minutes", `Float 37.); ("seconds", `Float 42.);
         ])
   and () =
-    let res =
-      Schematic.Json.decode Timmy.Daytime.schema
-        (`O
-          [
-            ("hours", `Float (-1.));
-            ("minutes", `Float 0.);
-            ("seconds", `Float 0.);
-          ])
-    in
-    Alcotest.(
-      check ~here:[%here]
-        (result daytime decoding_error)
-        "invalid daytime"
-        (Result.Error
-           Schematic.Error.
-             {
-               schema = Some "daytime";
-               path = [];
-               reason = "invalid hours: -1";
-             })
-        res)
+    try
+      let res =
+        Schematic.Json.decode Timmy.Daytime.schema
+          (`O
+            [
+              ("hours", `Float (-1.));
+              ("minutes", `Float 0.);
+              ("seconds", `Float 0.);
+            ])
+      in
+      Alcotest.(
+        check ~here:[%here]
+          (result daytime decoding_error)
+          "invalid daytime"
+          (Result.Error
+             Schematic.Error.
+               {
+                 schema = Some "daytime";
+                 path = [];
+                 reason = "invalid hours: -1";
+               })
+          res)
+    with
+    (* FIXME: because of schematic FFI limitations, this raises instead *)
+    | Failure "invalid hours: -1" ->
+      ()
   in
   ()
 
@@ -66,22 +73,27 @@ let week () =
       (Result.ok_or_failwith @@ Timmy.Week.make ~year:2022 42)
       (`O [ ("year", `Float 2022.); ("n", `Float 42.) ])
   and () =
-    let res =
-      Schematic.Json.decode Timmy.Week.schema
-        (`O [ ("year", `Float 2022.); ("n", `Float 53.) ])
-    in
-    Alcotest.(
-      check ~here:[%here]
-        (result week decoding_error)
-        "invalid daytime"
-        (Result.Error
-           Schematic.Error.
-             {
-               schema = Some "week";
-               path = [];
-               reason = "year 2022 has no week 53";
-             })
-        res)
+    try
+      let res =
+        Schematic.Json.decode Timmy.Week.schema
+          (`O [ ("year", `Float 2022.); ("n", `Float 53.) ])
+      in
+      Alcotest.(
+        check ~here:[%here]
+          (result week decoding_error)
+          "invalid daytime"
+          (Result.Error
+             Schematic.Error.
+               {
+                 schema = Some "week";
+                 path = [];
+                 reason = "year 2022 has no week 53";
+               })
+          res)
+    with
+    (* FIXME: because of schematic FFI limitations, this raises instead *)
+    | Failure "year 2022 has no week 53" ->
+      ()
   in
   ()
 

diff --git a/timmy/tests/test.ml b/timmy/tests/test.ml
@@ -13,7 +13,8 @@ module Time = struct
   let birthday = Timmy.Time.of_ptime ptime
 
   let ptime () =
-    Alcotest.check test_ptime "to_ptime" ptime (Timmy.Time.to_ptime birthday)
+    Alcotest.check ~here:[%here] test_ptime "to_ptime" ptime
+      (Timmy.Time.to_ptime birthday)
 
   let rfc3339 () =
     let () =
@@ -521,7 +522,7 @@ module Week = struct
       and exp = Timmy.Week.make ~year:year_exp n_exp |> Result.ok_or_failwith in
       let eff = Timmy.Week.(start + i)
       and name = Fmt.str "%a + %i" Timmy.Week.pp start i in
-      Alcotest.check week name exp eff
+      Alcotest.check ~here:[%here] week name exp eff
     in
     check (2021, 52) 0 (2021, 52);
     check (2021, 52) 1 (2022, 1);