#5980: a different warning for shadowing labels/constructors and for other kinds of identifiers. (Cherry-picked from commit 13796 on 4.01.)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13797 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

man/ocamlc.m

@@ -752,7 +752,7 @@ mentioned here corresponds to the empty set.
 
 .IP
 The default setting is
-.BR \-w\ +a\-4\-6\-9\-27\-29\-32..39\-42\-44 .
+.BR \-w\ +a\-4\-6\-9\-27\-29\-32..39\-42\-44-45 .
 Note that warnings
 .BR 5 \ and \ 10
 are not always triggered, depending on the internals of the type checker.

testsuite/tests/typing-warnings/records.ml

@@ -138,3 +138,23 @@ class g = f A;; (* ok *)
 
 class f (_ : 'a) (_ : 'a) = object end;;
 class g = f (A : t) A;; (* warn with -principal *)
+
+
+(* PR#5980 *)
+
+module Shadow1 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+  let y : t = {x = 0}
+end;;
+module Shadow2 = struct
+  type t = {x: int}
+  module M = struct
+    type s = {x: string}
+  end
+  open M  (* this open shadows label 'x' *)
+  let y = {x = ""}
+end;;

testsuite/tests/typing-warnings/records.ml.principal.reference

@@ -247,4 +247,33 @@ Characters 20-21:
                       ^
 Warning 42: this use of A required disambiguation.
 class g : f
+#                       Characters 199-200:
+    let y : t = {x = 0}
+                 ^
+Warning 42: this use of x required disambiguation.
+Characters 114-120:
+    open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+    ^^^^^^
+Warning 33: unused open M.
+module Shadow1 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : t
+  end
+#               Characters 97-103:
+    open M  (* this open shadows label 'x' *)
+    ^^^^^^
+Warning 45: this open statement shadows the label x (which is later used)
+Characters 149-157:
+    let y = {x = ""}
+            ^^^^^^^^
+Warning 41: these field labels belong to several types: M.s t
+The first one was selected. Please disambiguate if this is wrong.
+module Shadow2 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : M.s
+  end
 # 

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

@@ -246,4 +246,33 @@ Characters 20-21:
                       ^
 Warning 42: this use of A required disambiguation.
 class g : f
+#                       Characters 199-200:
+    let y : t = {x = 0}
+                 ^
+Warning 42: this use of x required disambiguation.
+Characters 114-120:
+    open M  (* this open is unused, it isn't reported as shadowing 'x' *)
+    ^^^^^^
+Warning 33: unused open M.
+module Shadow1 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : t
+  end
+#               Characters 97-103:
+    open M  (* this open shadows label 'x' *)
+    ^^^^^^
+Warning 45: this open statement shadows the label x (which is later used)
+Characters 149-157:
+    let y = {x = ""}
+            ^^^^^^^^
+Warning 41: these field labels belong to several types: M.s t
+The first one was selected. Please disambiguate if this is wrong.
+module Shadow2 :
+  sig
+    type t = { x : int; }
+    module M : sig type s = { x : string; } end
+    val y : M.s
+  end
 # 

typing/env.ml

@@ -1368,7 +1368,7 @@ let open_pers_signature name env =
   open_signature None (Pident(Ident.create_persistent name)) ps.ps_sig env
 
 let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env =
-  if not toplevel && ovf = Asttypes.Fresh && not loc.Location.loc_ghost && (Warnings.is_active (Warnings.Unused_open "") || Warnings.is_active (Warnings.Open_shadow_identifier ("", "")))
+  if not toplevel && ovf = Asttypes.Fresh && not loc.Location.loc_ghost && (Warnings.is_active (Warnings.Unused_open "") || Warnings.is_active (Warnings.Open_shadow_identifier ("", "")) || Warnings.is_active (Warnings.Open_shadow_label_constructor ("", "")))
   then begin
     let used = ref false in
     !add_delayed_check_forward
@@ -1380,7 +1380,12 @@ let open_signature ?(loc = Location.none) ?(toplevel = false) ovf root sg env =
     let slot kind s b =
       if b && not (List.mem (kind, s) !shadowed) then begin
         shadowed := (kind, s) :: !shadowed;
-        Location.prerr_warning loc (Warnings.Open_shadow_identifier (kind, s));
+        let w =
+          match kind with
+          | "label" | "constructor" -> Warnings.Open_shadow_label_constructor (kind, s)
+          | _ -> Warnings.Open_shadow_identifier (kind, s)
+        in
+        Location.prerr_warning loc w
       end;
       used := true
     in

utils/warnings.ml

@@ -62,6 +62,7 @@ type t =
   | Disambiguated_name of string            (* 42 *)
   | Nonoptional_label of string             (* 43 *)
   | Open_shadow_identifier of string * string (* 44 *)
+  | Open_shadow_label_constructor of string * string (* 45 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -115,9 +116,11 @@ let number = function
   | Disambiguated_name _ -> 42
   | Nonoptional_label _ -> 43
   | Open_shadow_identifier _ -> 44
+  | Open_shadow_label_constructor _ -> 45
+
 ;;
 
-let last_warning_number = 44
+let last_warning_number = 45
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -212,7 +215,7 @@ let parse_opt flags s =
 let parse_options errflag s = parse_opt (if errflag then error else active) s;;
 
 (* If you change these, don't forget to change them in man/ocamlc.m *)
-let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44";;
+let defaults_w = "+a-4-6-7-9-27-29-32..39-41..42-44-45";;
 let defaults_warn_error = "-a";;
 
 let () = parse_options false defaults_w;;
@@ -338,6 +341,10 @@ let message = function
       Printf.sprintf
         "this open statement shadows the %s identifier %s (which is later used)"
         kind s
+  | Open_shadow_label_constructor (kind, s) ->
+      Printf.sprintf
+        "this open statement shadows the %s %s (which is later used)"
+        kind s
 ;;
 
 let nerrors = ref 0;;
@@ -428,6 +435,7 @@ let descriptions =
    42, "Disambiguated constructor or label name.";
    43, "Nonoptional label applied as optional.";
    44, "Open statement shadows an already defined identifier.";
+   45, "Open statement shadows an already defined label or constructor.";
   ]
 ;;
 

utils/warnings.mli

@@ -57,6 +57,7 @@ type t =
   | Disambiguated_name of string            (* 42 *)
   | Nonoptional_label of string             (* 43 *)
   | Open_shadow_identifier of string * string (* 44 *)
+  | Open_shadow_label_constructor of string * string (* 45 *)
 ;;
 
 val parse_options : bool -> string -> unit;;