Merge pull request #552 from gasche/better-warning-on-unused-exception

PR#7139: clearer formulation of warning on unused exceptions

Changes

@@ -13,6 +13,12 @@ OCaml 4.04.0:
 - PR#7023, GPR#336: Better unboxing strategy
   (Alain Frisch, Pierre Chambart)
 
+### Language tooling and user interface
+
+- PR#7139: clarify the wording of Warning 38
+  (Unused exception or extension constructor)
+  (Gabriel Scherer)
+
 ### Tools:
 
 - GPR#452: Make the output of ocamldep is more stable

testsuite/tests/typing-warnings/unused_types.ml

@@ -16,3 +16,55 @@ end = struct
   type unused = A of unused
 end
 ;;
+
+module Unused_exception : sig
+end = struct
+  exception Nobody_uses_me
+end
+;;
+
+module Unused_extension_constructor : sig
+  type t = ..
+end = struct
+  type t = ..
+  type t += Nobody_uses_me
+end
+;;
+
+module Unused_exception_outside_patterns : sig
+  val falsity : exn -> bool
+end = struct
+  exception Nobody_constructs_me
+  let falsity = function
+    | Nobody_constructs_me -> true
+    | _ -> false
+end
+;;
+
+module Unused_extension_outside_patterns : sig
+  type t = ..
+  val falsity : t -> bool
+end = struct
+  type t = ..
+  type t += Nobody_constructs_me
+  let falsity = function
+    | Nobody_constructs_me -> true
+    | _ -> false
+end
+;;
+
+module Unused_private_exception : sig
+  type exn += private Private_exn
+end = struct
+  exception Private_exn
+end
+;;
+
+module Unused_private_extension : sig
+  type t = ..
+  type t += private Private_ext
+end = struct
+  type t = ..
+  type t += Private_ext
+end
+;;

testsuite/tests/typing-warnings/unused_types.ml.reference

@@ -18,4 +18,40 @@ Characters 40-65:
     ^^^^^^^^^^^^^^^^^^^^^^^^^
 Warning 37: unused constructor A.
 module Unused_rec : sig  end
+#           Characters 46-70:
+    exception Nobody_uses_me
+    ^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 38: unused exception Nobody_uses_me
+module Unused_exception : sig  end
+#               Characters 96-110:
+    type t += Nobody_uses_me
+              ^^^^^^^^^^^^^^
+Warning 38: unused extension constructor Nobody_uses_me
+module Unused_extension_constructor : sig type t = .. end
+#                   Characters 91-121:
+    exception Nobody_constructs_me
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Warning 38: exception Nobody_constructs_me is never used to build values.
+(However, this constructor appears in patterns.)
+module Unused_exception_outside_patterns : sig val falsity : exn -> bool end
+#                       Characters 127-147:
+    type t += Nobody_constructs_me
+              ^^^^^^^^^^^^^^^^^^^^
+Warning 38: extension constructor Nobody_constructs_me is never used to build values.
+(However, this constructor appears in patterns.)
+module Unused_extension_outside_patterns :
+  sig type t = .. val falsity : t -> bool end
+#             Characters 88-109:
+    exception Private_exn
+    ^^^^^^^^^^^^^^^^^^^^^
+Warning 38: exception Private_exn is never used to build values.
+It is exported or rebound as a private extension.
+module Unused_private_exception : sig type exn += private Private_exn end
+#                 Characters 124-135:
+    type t += Private_ext
+              ^^^^^^^^^^^
+Warning 38: extension constructor Private_ext is never used to build values.
+It is exported or rebound as a private extension.
+module Unused_private_extension :
+  sig type t = .. type t += private Private_ext end
 # 

typing/env.ml

@@ -1558,8 +1558,9 @@ and store_type_infos slot id path info env renv =
 and store_extension ~check slot id path ext env renv =
   let loc = ext.ext_loc in
   if check && not loc.Location.loc_ghost &&
-    Warnings.is_active (Warnings.Unused_extension ("", false, false))
+    Warnings.is_active (Warnings.Unused_extension ("", false, false, false))
   then begin
+    let is_exception = Path.same ext.ext_type_path Predef.path_exn in
     let ty = Path.last ext.ext_type_path in
     let n = Ident.name id in
     let k = (ty, loc, n) in
@@ -1571,7 +1572,7 @@ and store_extension ~check slot id path ext env renv =
           if not (is_in_signature env) && not used.cu_positive then
             Location.prerr_warning loc
               (Warnings.Unused_extension
-                 (n, used.cu_pattern, used.cu_privatize)
+                 (n, is_exception, used.cu_pattern, used.cu_privatize)
               )
         )
     end;

utils/warnings.ml

@@ -58,7 +58,7 @@ type t =
   | Unused_for_index of string              (* 35 *)
   | Unused_ancestor of string               (* 36 *)
   | Unused_constructor of string * bool * bool  (* 37 *)
-  | Unused_extension of string * bool * bool    (* 38 *)
+  | Unused_extension of string * bool * bool * bool (* 38 *)
   | Unused_rec_flag                         (* 39 *)
   | Name_out_of_scope of string * string list * bool (* 40 *)
   | Ambiguous_name of string list * string list *  bool    (* 41 *)
@@ -369,16 +369,21 @@ let message = function
       "constructor " ^ s ^
       " is never used to build values.\n\
         Its type is exported as a private type."
-  | Unused_extension (s, false, false) ->
-      "unused extension constructor " ^ s ^ "."
-  | Unused_extension (s, true, _) ->
-      "extension constructor " ^ s ^
-      " is never used to build values.\n\
-        (However, this constructor appears in patterns.)"
-  | Unused_extension (s, false, true) ->
-      "extension constructor " ^ s ^
-      " is never used to build values.\n\
-        It is exported or rebound as a private extension."
+  | Unused_extension (s, is_exception, cu_pattern, cu_privatize) ->
+     let kind =
+       if is_exception then "exception" else "extension constructor" in
+     let name = kind ^ " " ^ s in
+     begin match cu_pattern, cu_privatize with
+       | false, false -> "unused " ^ name
+       | true, _ ->
+          name ^
+          " is never used to build values.\n\
+           (However, this constructor appears in patterns.)"
+       | false, true ->
+          name ^
+          " is never used to build values.\n\
+            It is exported or rebound as a private extension."
+     end
   | Unused_rec_flag ->
       "unused rec flag."
   | Name_out_of_scope (ty, [nm], false) ->

utils/warnings.mli

@@ -53,7 +53,7 @@ type t =
   | Unused_for_index of string              (* 35 *)
   | Unused_ancestor of string               (* 36 *)
   | Unused_constructor of string * bool * bool (* 37 *)
-  | Unused_extension of string * bool * bool   (* 38 *)
+  | Unused_extension of string * bool * bool * bool (* 38 *)
   | Unused_rec_flag                         (* 39 *)
   | Name_out_of_scope of string * string list * bool   (* 40 *)
   | Ambiguous_name of string list * string list * bool (* 41 *)