Make -unused-code-warnings also controls warning 34 suppression items.

Update CHANGES.md Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com> Signed-off-by: Mathieu Barbin <[email protected]>
ocaml-ppx · Jul 15, 2024 · b041ff1 · b041ff1
1 parent 4aadc5f
commit b041ff1
Show file tree

Hide file tree

Showing 3 changed files with 40 additions and 21 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -14,6 +14,10 @@ details.
 
 ### Other changes
 
+- Make `-unused-code-warnings` flag to the driver also controls the generation
+  of warning 34 silencing structure items when using `[@@deriving ...]` on type
+  declarations. (#510, @mbarbin, @NathanReb)
+
 - Driver: Add `-unused-code-warnings=force` command-line flag argument. (#490, @mbarbin)
 
 - new functions `Ast_builder.{e,p}list_tail` that take an extra tail

diff --git a/src/deriving.ml b/src/deriving.ml
@@ -253,7 +253,11 @@ module Generator = struct
       List.concat lerr
       |> List.map ~f:(fun err -> ext_to_item ~loc:Location.none err [])
     in
-    List.concat l1 @ [ { items = lerr; unused_code_warnings = false } ]
+    List.concat l1
+    @
+    match lerr with
+    | [] -> []
+    | _ :: _ as lerr -> [ { items = lerr; unused_code_warnings = false } ]
 end
 
 module Deriver = struct
@@ -712,8 +716,13 @@ let wrap_sig ~loc ~hide list =
    | Main expansion                                                  |
    +-----------------------------------------------------------------+ *)
 
-let types_used_by_deriving (tds : type_declaration list) : structure_item list =
-  if keep_w32_impl () then []
+let types_used_by_deriving (tds : type_declaration list) ~unused_code_warnings :
+    structure_item list =
+  let unused_code_warnings =
+    allow_unused_code_warnings
+      ~ppx_allows_unused_code_warnings:unused_code_warnings
+  in
+  if keep_w32_impl () || unused_code_warnings then []
   else
     List.map tds ~f:(fun td ->
         let typ = Common.core_type_of_type_declaration td in
@@ -749,12 +758,22 @@ let expand_str_type_decls ~ctxt rec_flag tds values =
         Ast_builder.Default.pstr_extension ~loc:Location.none err [])
       l_err
   in
-  (* TODO: instead of disabling the unused warning for types themselves, we
-     should add a tag [@@unused]. *)
   let generated =
-    { items = types_used_by_deriving tds @ l_err; unused_code_warnings = false }
-    :: Generator.apply_all ~ctxt (rec_flag, tds) generators
-         Ast_builder.Default.pstr_extension
+    let from_generators =
+      Generator.apply_all ~ctxt (rec_flag, tds) generators
+        Ast_builder.Default.pstr_extension
+    in
+    let unused_code_warnings =
+      List.for_all from_generators
+        ~f:(fun { unused_code_warnings; items = _ } -> unused_code_warnings)
+    in
+    (* TODO: instead of disabling the unused warning for types themselves, we
+       should add a tag [@@unused]. *)
+    {
+      items = types_used_by_deriving tds ~unused_code_warnings @ l_err;
+      unused_code_warnings = false;
+    }
+    :: from_generators
     |> merge_derived
   in
   wrap_str

diff --git a/test/deriving_warning/run.t b/test/deriving_warning/run.t
@@ -11,7 +11,7 @@ the emission of such warning silencing features.
 
 One such flag and optional argument pair is the `-unused-code-warnings` flag and
 `?unused_code_warning` `Deriving.V2.make` argument. Both of those default to
-`false` and control whether we disable warnings 32 and 60 for generated code
+`false` and control whether we disable warnings 32, 34 and 60 for generated code
 and behave as described by the following table:
 
  Deriver arg | Driver Flag | Unused Code Warnings
@@ -23,7 +23,7 @@ and behave as described by the following table:
  false       | false       | Disabled
  false       | force       | Enabled
 * By adding warning silencers like [@@@ocaml.waring "-60"] or producing code like
-`let _ = zero in...`
+`let _ = zero in...` or `let _ = fun (_ : t) -> ()`.
 
 We have a driver with 4 derivers linked in:
 - zero_do_warn
@@ -60,14 +60,12 @@ Let's call the driver with -unused-code-warnings=false:
 
 The generated code is wrapped in an include struct ... end to disable unused module
 warnings, as expected. The derived value zero is followed by a let _ = zero to
-disable unused value warning.
+disable unused value warning, and the type is used by `let _ = fun (_ : t) -> ()`.
 
 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 module Zero = struct type t =
                                         | T0  end
                  let zero = Zero.T0 end[@@ocaml.doc "@inline"][@@merlin.hide ]
@@ -130,8 +128,6 @@ the deriver `zero_do_warn` already allows the warning to be enabled.
 
   $ ./driver.exe -unused-code-warnings=force -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 module Zero = struct type t =
                                         | T0  end
                  let zero = Zero.T0 end[@@ocaml.doc "@inline"][@@merlin.hide ]
@@ -209,7 +205,6 @@ what the `force` argument for the driver flag is for. See below:
   type t = int[@@deriving one_no_warn]
   include
     struct
-      let _ = fun (_ : t) -> ()
       module One = struct type 'a t =
                             | T1 of 'a  end
       let one = One.T1 zero
@@ -247,8 +242,11 @@ unit_one:
   include struct let unit_two = unit_one
                  let _ = unit_two end[@@ocaml.doc "@inline"][@@merlin.hide ]
 
-As expected, there is a let _ = unit_two but nothing for unit_one. If we turn off
-the unused-code-warnings flag, there will be one for both:
+As expected, there is a let _ = unit_two but nothing for unit_one. Since unit_one does
+not allow the warning 34 to be enabled, you can see that the combination of both derivers
+still keeps the `let _ = fun (_ : t) -> ()` construct.
+
+If we turn off the unused-code-warnings flag, there will be a `let _ = ...` for both:
 
   $ ./driver.exe -unused-code-warnings=false -impl alias_warn.ml
   type t = int[@@deriving alias_warn]
@@ -260,12 +258,10 @@ the unused-code-warnings flag, there will be one for both:
                  let _ = unit_two end[@@ocaml.doc "@inline"][@@merlin.hide ]
 
 As expected, if we force the unused-code-warnings, there will be no let _ for
-any of the two values.
+any of the two values, and no construct to use the type t:
 
   $ ./driver.exe -unused-code-warnings=force -impl alias_warn.ml
   type t = int[@@deriving alias_warn]
-  include struct let _ = fun (_ : 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 end[@@ocaml.doc "@inline"][@@merlin.hide
                                                                      ]