In progress: constant_type and special_functions can report multiple…

… errors

Signed-off-by: Burnleydev1 <[email protected]>

src/context_free.ml

@@ -512,7 +512,7 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
         | None -> super#expression base_ctxt e
         | Some expand -> (
             try self#expression base_ctxt (expand e.pexp_loc text)
-            with exn -> (e, [ exn_to_error exn ]))
+            with exn when embed_errors -> (e, [ exn_to_error exn ]))
       in
       match e.pexp_desc with
       | Pexp_apply (({ pexp_desc = Pexp_ident id; _ } as func), args) -> (
@@ -524,18 +524,24 @@ class map_top_down ?(expect_mismatch_handler = Expect_mismatch_handler.nop)
               | None ->
                   self#pexp_apply_without_traversing_function base_ctxt e func
                     args
-              | Some e -> self#expression base_ctxt e))
+              | Some e -> (
+                  try self#expression base_ctxt e
+                  with exn when embed_errors -> (e, [ exn_to_error exn ]))))
       | Pexp_ident id -> (
           match Hashtbl.find_opt special_functions id.txt with
           | None -> super#expression base_ctxt e
           | Some pattern -> (
               match pattern e with
               | None -> super#expression base_ctxt e
-              | Some e -> self#expression base_ctxt e))
+              | Some e -> (
+                  try self#expression base_ctxt e
+                  with exn when embed_errors -> (e, [ exn_to_error exn ]))))
       | Pexp_constant (Pconst_integer (s, Some c)) ->
           expand_constant Integer c s
       | Pexp_constant (Pconst_float (s, Some c)) -> expand_constant Float c s
-      | _ -> super#expression base_ctxt e
+      | _ -> (
+          try super#expression base_ctxt e
+          with exn when embed_errors -> (e, [ exn_to_error exn ]))
 
     (* Pre-conditions:
        - e.pexp_desc = Pexp_apply(func, args)

test/driver/exception_handling/constant_type.ml

@@ -0,0 +1,9 @@
+open Ppxlib
+
+let kind = Context_free.Rule.Constant_kind.Integer
+let rewriter loc s = Location.raise_errorf ~loc "rewriter %s failed" s
+let rule = Context_free.Rule.constant kind 'g' rewriter;;
+
+Driver.register_transformation ~rules:[ rule ] "constant"
+
+let () = Driver.standalone ()

test/driver/exception_handling/dune

@@ -1,8 +1,8 @@
 (executables
  (names whole_file_exception whole_file_extension_point
-   whole_file_located_error extender deriver)
+   whole_file_located_error extender deriver constant_type special_functions)
  (libraries ppxlib))
 
 (cram
  (deps extender.exe whole_file_exception.exe whole_file_located_error.exe
-   deriver.exe whole_file_extension_point.exe))
+   deriver.exe whole_file_extension_point.exe constant_type.exe special_functions.exe))

test/driver/exception_handling/run.t

@@ -162,8 +162,43 @@ when the -embed-errors flag is not passed
   Fatal error: exception Failure("A raised exception")
   [2]
 
+ In the case of Constant types
+
+  $ echo "let x = 2g + 3g" > impl.ml
+  $ echo "let x = 2g + 3g" >> impl.ml
+
+ When embed-errors is not passed 
+  $ ./constant_type.exe impl.ml
+  File "impl.ml", line 1, characters 8-10:
+  Error: rewriter 2 failed
+  [1]
+
+ When embed-errors is not passed
+  $ ./constant_type.exe -embed-errors impl.ml
+  [%%ocaml.error "rewriter 2 failed"]
+  [%%ocaml.error "rewriter 3 failed"]
+  [%%ocaml.error "rewriter 2 failed"]
+  [%%ocaml.error "rewriter 3 failed"]
+  let x = 2g + 3g
+  let x = 2g + 3g
+
+ In the case of Special functions
+
+  $ echo "let _ = (f_macro arg1 arg2, f_macro)" > impl.ml
+  $ echo "let _ = (f_macro arg1 arg2, f_macro)" >> impl.ml
+ When embed-errors is not passed 
+  $ ./special_functions.exe impl.ml
+  let _ = ((f_macro arg1 arg2), f_macro)
+  let _ = ((f_macro arg1 arg2), f_macro)
+
+ When embed-errors is not passed
+  $ ./special_functions.exe -embed-errors impl.ml
+  let _ = ((f_macro arg1 arg2), f_macro)
+  let _ = ((f_macro arg1 arg2), f_macro)
+
  In the case of whole file transformations:
 
+  $ echo "let _ = [%gen_raise_exc] + [%gen_raise_exc]" > impl.ml
   $ ./whole_file_exception.exe impl.ml
   Fatal error: exception Failure("An exception in a whole file transform")
   [2]

test/driver/exception_handling/special_functions.ml

@@ -0,0 +1,11 @@
+open Ppxlib
+
+let expand e =
+  let loc = e.pexp_loc in
+  Location.raise_errorf ~loc "This is an example error"
+
+let rule = Context_free.Rule.special_function "n_args" expand
+
+let () =
+  Driver.register_transformation ~rules:[ rule ] "special_function_demo";
+  Driver.standalone ()