Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Change construct generated by driver to silence warning 34 #495

Closed
wants to merge 1 commit into from
Closed

Change construct generated by driver to silence warning 34 #495

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ]`.
Expand Down
19 changes: 16 additions & 3 deletions src/deriving.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
2 changes: 1 addition & 1 deletion test/deriving/inline/example/ppx_deriving_example.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
29 changes: 17 additions & 12 deletions test/deriving_warning/run.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"]
Expand All @@ -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 ]
Expand Down Expand Up @@ -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"]
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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 ]
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion test/driver/exception_handling/run.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ]

Expand Down
18 changes: 10 additions & 8 deletions test/error_embedding/run.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 ]
Expand All @@ -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 ]
Expand All @@ -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"
Expand All @@ -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"
Expand All @@ -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 ]
Loading