Insert errors for special functions and constants as well

Signed-off-by: Nathan Rebours <[email protected]>
ocaml-ppx · Feb 12, 2024 · 245db3a · 245db3a
1 parent c9c2b25
commit 245db3a
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 18 deletions.
diff --git a/src/context_free.ml b/src/context_free.ml
@@ -567,7 +567,8 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
           | Some pattern -> (
               let generated_code =
                 try return (pattern e)
-                with exn when embed_errors -> (None, [ exn_to_loc_error exn ])
+                with exn when embed_errors ->
+                  return (Some (exn_to_error_extension EC.expression e exn))
               in
               generated_code >>= fun expr ->
               match expr with
@@ -581,18 +582,21 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
           | Some pattern -> (
               let generated_code =
                 try return (pattern e)
-                with exn when embed_errors -> (None, [ exn_to_loc_error exn ])
+                with exn when embed_errors ->
+                  return (Some (exn_to_error_extension EC.expression e exn))
               in
               generated_code >>= fun expr ->
               match expr with
               | None -> super#expression base_ctxt e
               | Some e -> self#expression base_ctxt e))
       | Pexp_constant (Pconst_integer (s, Some c)) -> (
           try expand_constant Integer c s
-          with exn when embed_errors -> (e, [ exn_to_loc_error exn ]))
+          with exn when embed_errors ->
+            return (exn_to_error_extension EC.expression e exn))
       | Pexp_constant (Pconst_float (s, Some c)) -> (
           try expand_constant Float c s
-          with exn when embed_errors -> (e, [ exn_to_loc_error exn ]))
+          with exn when embed_errors ->
+            return (exn_to_error_extension EC.expression e exn))
       | _ -> super#expression base_ctxt e
 
     (* Pre-conditions:

diff --git a/test/driver/exception_handling/run.t b/test/driver/exception_handling/run.t
@@ -171,16 +171,18 @@ when the -embed-errors flag is not passed
 
  When embed-errors is not passed
   $ ./constant_type.exe -embed-errors impl.ml
-  [%%ocaml.error
-    "A raised located error in the constant rewriting transformation."]
-  [%%ocaml.error
-    "A raised located error in the constant rewriting transformation."]
-  [%%ocaml.error
-    "A raised located error in the constant rewriting transformation."]
-  [%%ocaml.error
-    "A raised located error in the constant rewriting transformation."]
-  let x = 2g + 3g
-  let x = 2g + 3g
+  let x =
+    ([%ocaml.error
+       "A raised located error in the constant rewriting transformation."])
+      +
+      ([%ocaml.error
+         "A raised located error in the constant rewriting transformation."])
+  let x =
+    ([%ocaml.error
+       "A raised located error in the constant rewriting transformation."])
+      +
+      ([%ocaml.error
+         "A raised located error in the constant rewriting transformation."])
 
  In the case of Special functions
 
@@ -194,10 +196,8 @@ when the -embed-errors flag is not passed
 
  When embed-errors is not passed
   $ ./special_functions.exe -embed-errors impl.ml
-  [%%ocaml.error "error special function"]
-  [%%ocaml.error "second error special function"]
-  let x1 = n_args
-  let x2 = n_args2
+  let x1 = [%ocaml.error "error special function"]
+  let x2 = [%ocaml.error "second error special function"]
 
  In the case of whole file transformations: