diff --git a/CHANGES.md b/CHANGES.md index 0b572d0a9..953a6b092 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -14,6 +14,9 @@ details. ### Other changes +- Driver: Change the construct generated to silence warning 34 to work + better with coverage tools such as `bisect_ppx`. (#495, @mbarbin) + - new functions `Ast_builder.{e,p}list_tail` that take an extra tail expression/pattern argument parameter compared to `Ast_builder.{e,p}list`, so they can build ASTs like `a :: b :: c` instead of only `[ a; b ]`. diff --git a/src/deriving.ml b/src/deriving.ml index 90e33fcab..01c7a7cdb 100644 --- a/src/deriving.ml +++ b/src/deriving.ml @@ -710,9 +710,22 @@ let types_used_by_deriving (tds : type_declaration list) : structure_item list = [ value_binding ~loc ~pat:(ppat_any ~loc) ~expr: - (pexp_fun ~loc Nolabel None - (ppat_constraint ~loc (ppat_any ~loc) typ) - (eunit ~loc)); + (pexp_constraint ~loc + (pexp_variant ~loc "None" None) + (ptyp_variant ~loc + [ + { + prf_desc = Rtag ({ txt = "None"; loc }, true, []); + prf_loc = loc; + prf_attributes = []; + }; + { + prf_desc = Rtag ({ txt = "Some"; loc }, false, [ typ ]); + prf_loc = loc; + prf_attributes = []; + }; + ] + Closed None)); ]) let merge_generators field l = diff --git a/test/deriving/inline/example/ppx_deriving_example.ml b/test/deriving/inline/example/ppx_deriving_example.ml index 75b8d462e..3714bb589 100644 --- a/test/deriving/inline/example/ppx_deriving_example.ml +++ b/test/deriving/inline/example/ppx_deriving_example.ml @@ -3,7 +3,7 @@ type t = A [@@deriving_inline foo] include struct [@@@ocaml.warning "-60"] - let _ = fun (_ : t) -> () + let _ = (`None : [ `None | `Some of t ]) module Foo = struct end diff --git a/test/deriving_warning/run.t b/test/deriving_warning/run.t index 5d4c19641..c5ffa3b7b 100644 --- a/test/deriving_warning/run.t +++ b/test/deriving_warning/run.t @@ -42,8 +42,9 @@ Let's call the driver with -unused-code-warnings=false: $ ./driver.exe -unused-code-warnings=false -impl zero_do_warn.ml type t = int[@@deriving zero_do_warn] - include struct let _ = fun (_ : t) -> () end[@@ocaml.doc "@inline"][@@merlin.hide - ] + include struct let _ = (`None : [ `None | `Some of t ]) end[@@ocaml.doc + "@inline"] + [@@merlin.hide ] include struct [@@@ocaml.warning "-60"] @@ -61,8 +62,9 @@ Now if we use -unused-code-warnings=true: $ ./driver.exe -unused-code-warnings=true -impl zero_do_warn.ml type t = int[@@deriving zero_do_warn] - include struct let _ = fun (_ : t) -> () end[@@ocaml.doc "@inline"][@@merlin.hide - ] + include struct let _ = (`None : [ `None | `Some of t ]) end[@@ocaml.doc + "@inline"] + [@@merlin.hide ] include struct module Zero = struct type t = | T0 end let zero = Zero.T0 end[@@ocaml.doc "@inline"][@@merlin.hide ] @@ -102,8 +104,9 @@ The default value of the -unused-code-warnings should be false: $ ./driver.exe -impl zero_do_warn.ml type t = int[@@deriving zero_do_warn] - include struct let _ = fun (_ : t) -> () end[@@ocaml.doc "@inline"][@@merlin.hide - ] + include struct let _ = (`None : [ `None | `Some of t ]) end[@@ocaml.doc + "@inline"] + [@@merlin.hide ] include struct [@@@ocaml.warning "-60"] @@ -134,7 +137,7 @@ output: include struct [@@@ocaml.warning "-60"] - let _ = fun (_ : t) -> () + let _ = (`None : [ `None | `Some of t ]) module One = struct type 'a t = | T1 of 'a end let one = One.T1 zero @@ -146,7 +149,7 @@ output: include struct [@@@ocaml.warning "-60"] - let _ = fun (_ : t) -> () + let _ = (`None : [ `None | `Some of t ]) module One = struct type 'a t = | T1 of 'a end let one = One.T1 zero @@ -196,8 +199,9 @@ unit_one: $ ./driver.exe -unused-code-warnings=true -impl alias_warn.ml type t = int[@@deriving alias_warn] - include struct let _ = fun (_ : t) -> () end[@@ocaml.doc "@inline"][@@merlin.hide - ] + include struct let _ = (`None : [ `None | `Some of t ]) end[@@ocaml.doc + "@inline"] + [@@merlin.hide ] include struct let unit_one = () end[@@ocaml.doc "@inline"][@@merlin.hide ] include struct let unit_two = unit_one let _ = unit_two end[@@ocaml.doc "@inline"][@@merlin.hide ] @@ -207,8 +211,9 @@ the unused-code-warnings flag, there will be one for both: $ ./driver.exe -unused-code-warnings=false -impl alias_warn.ml type t = int[@@deriving alias_warn] - include struct let _ = fun (_ : t) -> () end[@@ocaml.doc "@inline"][@@merlin.hide - ] + include struct let _ = (`None : [ `None | `Some of t ]) end[@@ocaml.doc + "@inline"] + [@@merlin.hide ] include struct let unit_one = () let _ = unit_one end[@@ocaml.doc "@inline"][@@merlin.hide ] include struct let unit_two = unit_one diff --git a/test/driver/exception_handling/run.t b/test/driver/exception_handling/run.t index 3fc684ec9..0dfb66350 100644 --- a/test/driver/exception_handling/run.t +++ b/test/driver/exception_handling/run.t @@ -23,7 +23,7 @@ is rewritten to contain two of these nodes. type a = int[@@deriving deriver_extension_node] include struct - let _ = fun (_ : a) -> () + let _ = (`None : [ `None | `Some of a ]) [%%ocaml.error "An error message in an extension node"] end[@@ocaml.doc "@inline"][@@merlin.hide ] diff --git a/test/error_embedding/run.t b/test/error_embedding/run.t index 998f19e2f..55a41defe 100644 --- a/test/error_embedding/run.t +++ b/test/error_embedding/run.t @@ -8,7 +8,7 @@ Undefined derivers are turned into error nodes type t = int[@@deriving undefined] include struct - let _ = fun (_ : t) -> () + let _ = (`None : [ `None | `Some of t ]) [%%ocaml.error "Ppxlib.Deriving: 'undefined' is not a supported type deriving generator"] end[@@ocaml.doc "@inline"][@@merlin.hide ] @@ -32,13 +32,15 @@ Anything else will embed an error extension node $ echo "type b = int [@@deriving a_string unexpected_args]" >> parsing_payload_deriver.ml $ ./deriver.exe parsing_payload_deriver.ml type a = int[@@deriving a_string] - include struct let _ = fun (_ : a) -> () - let _ = "derived_string" end[@@ocaml.doc "@inline"][@@merlin.hide - ] + include + struct + let _ = (`None : [ `None | `Some of a ]) + let _ = "derived_string" + end[@@ocaml.doc "@inline"][@@merlin.hide ] type b = int[@@deriving a_string unexpected_args] include struct - let _ = fun (_ : b) -> () + let _ = (`None : [ `None | `Some of b ]) [%%ocaml.error "Ppxlib.Deriving: non-optional labelled argument or record expected"] end[@@ocaml.doc "@inline"][@@merlin.hide ] @@ -50,7 +52,7 @@ Error nodes are generated when dependent derivers are not applied. type a = int[@@deriving a_dependent_string] include struct - let _ = fun (_ : a) -> () + let _ = (`None : [ `None | `Some of a ]) [%%ocaml.error "Deriver a_string is needed for a_dependent_string, you need to add it before in the list"] let _ = "derived_string" @@ -60,7 +62,7 @@ Error nodes are generated when dependent derivers are not applied. type b = int[@@deriving (a_dependent_string, a_string)] include struct - let _ = fun (_ : b) -> () + let _ = (`None : [ `None | `Some of b ]) [%%ocaml.error "Deriver a_string is needed for a_dependent_string, you need to add it before in the list"] let _ = "derived_string" @@ -71,7 +73,7 @@ Error nodes are generated when dependent derivers are not applied. type b = int[@@deriving (a_string, a_dependent_string)] include struct - let _ = fun (_ : b) -> () + let _ = (`None : [ `None | `Some of b ]) let _ = "derived_string" let _ = "derived_string" end[@@ocaml.doc "@inline"][@@merlin.hide ]