From 80b48b7a69a8054734619078103df9947874c73e Mon Sep 17 00:00:00 2001
From: Jacques Garrigue <garrigue at math.nagoya-u.ac.jp>
Date: Fri, 30 Apr 2010 06:26:51 +0000
Subject: [PATCH] make duplicate definitions a warning rather than an error

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10332 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
---
 typing/typedecl.ml  | 21 +++++++++------------
 typing/typedecl.mli |  1 -
 utils/warnings.ml   |  9 +++++++--
 utils/warnings.mli  |  1 +
 4 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index ec64eaede..1d0eaad1d 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -42,7 +42,6 @@ type error =
   | Unavailable_type_constructor of Path.t
   | Bad_fixed_type of string
   | Unbound_type_var_exc of type_expr * type_expr
-  | Duplicate_definitions of string * string * string * string
 
 exception Error of Location.t * error
 
@@ -600,10 +599,10 @@ let compute_variance_decls env cldecls =
        {cltydef with clty_variance = variance}))
     decls cldecls
 
-(* Check multiple declarations of fields/constructors *)
+(* Check multiple declarations of labels/constructors *)
 
 let check_duplicates name_sdecl_list =
-  let fields = Hashtbl.create 7 and constrs = Hashtbl.create 7 in
+  let labels = Hashtbl.create 7 and constrs = Hashtbl.create 7 in
   List.iter
     (fun (name, sdecl) -> match sdecl.ptype_kind with
       Ptype_variant cl ->
@@ -611,18 +610,19 @@ let check_duplicates name_sdecl_list =
           (fun (cname, _, loc) ->
             try
               let name' = Hashtbl.find constrs cname in
-              raise (Error (loc, Duplicate_definitions
-                              ("constructor", cname, name', name)))
+              Location.prerr_warning loc
+                (Warnings.Duplicate_definitions
+                   ("constructor", cname, name', name))
             with Not_found -> Hashtbl.add constrs cname name)
           cl
     | Ptype_record fl ->
         List.iter
           (fun (cname, _, _, loc) ->
             try
-              let name' = Hashtbl.find fields cname in
-              raise (Error (loc, Duplicate_definitions
-                              ("field", cname, name', name)))
-            with Not_found -> Hashtbl.add fields cname name)
+              let name' = Hashtbl.find labels cname in
+              Location.prerr_warning loc
+                (Warnings.Duplicate_definitions ("label", cname, name', name))
+            with Not_found -> Hashtbl.add labels cname name)
           fl
     | Ptype_abstract -> ())
     name_sdecl_list
@@ -982,6 +982,3 @@ let report_error ppf = function
       fprintf ppf "The definition of type %a@ is unavailable" Printtyp.path p
   | Bad_fixed_type r ->
       fprintf ppf "This fixed type %s" r
-  | Duplicate_definitions (kind, cname, tc1, tc2) ->
-      fprintf ppf "The %s %s is defined both in types %s and %s."
-        kind cname tc1 tc2
diff --git a/typing/typedecl.mli b/typing/typedecl.mli
index 969d3ec78..c44f467d7 100644
--- a/typing/typedecl.mli
+++ b/typing/typedecl.mli
@@ -71,7 +71,6 @@ type error =
   | Unavailable_type_constructor of Path.t
   | Bad_fixed_type of string
   | Unbound_type_var_exc of type_expr * type_expr
-  | Duplicate_definitions of string * string * string * string
 
 exception Error of Location.t * error
 
diff --git a/utils/warnings.ml b/utils/warnings.ml
index fee099bd4..8b9727339 100644
--- a/utils/warnings.ml
+++ b/utils/warnings.ml
@@ -49,6 +49,7 @@ type t =
   | Unused_var_strict of string             (* 27 *)
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
+  | Duplicate_definitions of string * string * string * string (*30 *)
 ;;
 
 (* If you remove a warning, leave a hole in the numbering.  NEVER change
@@ -87,9 +88,10 @@ let number = function
   | Unused_var_strict _ -> 27
   | Wildcard_arg_to_constant_constr -> 28
   | Eol_in_string -> 29
+  | Duplicate_definitions _ -> 30
 ;;
 
-let last_warning_number = 29;;
+let last_warning_number = 30;;
 (* Must be the max number returned by the [number] function. *)
 
 let letter = function
@@ -118,7 +120,7 @@ let letter = function
   | 'u' -> [11; 12]
   | 'v' -> [13]
   | 'w' -> []
-  | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25]
+  | 'x' -> [14; 15; 16; 17; 18; 19; 20; 21; 22; 23; 24; 25; 30]
   | 'y' -> [26]
   | 'z' -> [27]
   | _ -> assert false
@@ -250,6 +252,9 @@ let message = function
      "wildcard pattern given as argument to a constant constructor"
   | Eol_in_string ->
      "unescaped end-of-line in a string constant (non-portable code)"
+  | Duplicate_definitions (kind, cname, tc1, tc2) ->
+      Printf.sprintf "the %s %s is defined both in types %s and %s."
+        kind cname tc1 tc2
 ;;
 
 let nerrors = ref 0;;
diff --git a/utils/warnings.mli b/utils/warnings.mli
index 0664788ed..d733f837c 100644
--- a/utils/warnings.mli
+++ b/utils/warnings.mli
@@ -44,6 +44,7 @@ type t =
   | Unused_var_strict of string             (* 27 *)
   | Wildcard_arg_to_constant_constr         (* 28 *)
   | Eol_in_string                           (* 29 *)
+  | Duplicate_definitions of string * string * string * string (*30 *)
 ;;
 
 val parse_options : bool -> string -> unit;;