From c76b791ca4b77a4d2c14b46d30fc99b4a8b3e45c Mon Sep 17 00:00:00 2001 From: Jacques Garrigue Date: Tue, 19 Feb 2013 02:45:09 +0000 Subject: Add warning 42 for disambiguated labels and constructors (compatibility with old versions) git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13297 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- typing/typecore.ml | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'typing') diff --git a/typing/typecore.ml b/typing/typecore.ml index f082484947..f13e715852 100644 --- a/typing/typecore.ml +++ b/typing/typecore.ml @@ -597,7 +597,8 @@ end) = struct let disambiguate ?(warn=Location.prerr_warning) ?(check_lk=fun _ _ -> ()) ?scope lid env opath lbls = - match opath with + let scope = match scope with None -> lbls | Some l -> l in + let lbl = match opath with None -> begin match lbls with [] -> unbound_name_error env lid @@ -609,7 +610,6 @@ end) = struct lbl end | Some(tpath0, tpath, pr) -> - let scope = match scope with None -> lbls | Some l -> l in let warn_pr () = let kind = if type_kind = "record" then "field" else "constructor" in warn lid.loc @@ -651,6 +651,14 @@ end) = struct in raise (Error (lid.loc, env, Name_type_mismatch (type_kind, lid.txt, tp, tpl))) + in + begin match scope with + (lab1,_)::_ when lab1 == lbl -> () + | _ -> + Location.prerr_warning lid.loc + (Warnings.Disambiguated_name(get_name lbl)) + end; + lbl end module Label = NameChoice (struct -- cgit v1.2.1