From 4f24f8ab0f1d21633ae3263b2d8f89bf1b92c118 Mon Sep 17 00:00:00 2001 From: Alain Frisch Date: May 17 2013 10:12:31 +0000 Subject: #5980: only report shadowing against the environment before the 'open'. git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13689 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- diff --git a/testsuite/tests/typing-warnings/records.ml.principal.reference b/testsuite/tests/typing-warnings/records.ml.principal.reference index b11a54d..7a7745a 100644 --- a/testsuite/tests/typing-warnings/records.ml.principal.reference +++ b/testsuite/tests/typing-warnings/records.ml.principal.reference @@ -31,15 +31,7 @@ Characters 148-149: Warning 27: unused variable x. module OK : sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end -# Characters 22-29: - open M1 - ^^^^^^^ -Warning 44: this open statement shadows the label identifier x (which is later used) -Characters 22-29: - open M1 - ^^^^^^^ -Warning 44: this open statement shadows the label identifier y (which is later used) -Characters 55-61: +# Characters 55-61: let f r = match r with {x; y} -> y + y ^^^^^^ Warning 41: these field labels belong to several types: M1.u M1.t @@ -49,15 +41,7 @@ Characters 65-66: ^ Error: This expression has type bool but an expression was expected of type int -# Characters 22-29: - open M1 - ^^^^^^^ -Warning 44: this open statement shadows the label identifier x (which is later used) -Characters 22-29: - open M1 - ^^^^^^^ -Warning 44: this open statement shadows the label identifier y (which is later used) -Characters 85-91: +# Characters 85-91: {x; y} -> y + y ^^^^^^ Warning 41: these field labels belong to several types: M1.u M1.t diff --git a/testsuite/tests/typing-warnings/records.ml.reference b/testsuite/tests/typing-warnings/records.ml.reference index 3de315c..c88439c 100644 --- a/testsuite/tests/typing-warnings/records.ml.reference +++ b/testsuite/tests/typing-warnings/records.ml.reference @@ -27,15 +27,7 @@ Characters 148-149: Warning 27: unused variable x. module OK : sig val f1 : M1.t -> int val f2 : M1.t -> int val f3 : M1.t -> int end -# Characters 22-29: - open M1 - ^^^^^^^ -Warning 44: this open statement shadows the label identifier x (which is later used) -Characters 22-29: - open M1 - ^^^^^^^ -Warning 44: this open statement shadows the label identifier y (which is later used) -Characters 55-61: +# Characters 55-61: let f r = match r with {x; y} -> y + y ^^^^^^ Warning 41: these field labels belong to several types: M1.u M1.t diff --git a/typing/env.ml b/typing/env.ml index 43efbd4..5a817fa 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -122,14 +122,14 @@ module EnvTbl = try ignore (Ident.find_name s tbl); true with Not_found -> false - let add kind slot id x tbl = + let add kind slot id x tbl ref_tbl = let slot = match slot with | None -> nothing | Some f -> (fun () -> let s = Ident.name id in - f kind s (already_defined s tbl) + f kind s (already_defined s ref_tbl) ) in Ident.add id (x, slot) tbl @@ -1072,7 +1072,7 @@ and components_of_module_maker (env, sub, path, mty) = c.comp_labels <- add_to_tbl descr.lbl_name (descr, nopos) c.comp_labels) labels; - env := store_type_infos None id path decl !env + env := store_type_infos None id path decl !env !env | Sig_exception(id, decl) -> let decl' = Subst.exception_declaration sub decl in let cstr = Datarepr.exception_descr path decl' in @@ -1087,13 +1087,13 @@ and components_of_module_maker (env, sub, path, mty) = let comps = components_of_module !env sub path mty in c.comp_components <- Tbl.add (Ident.name id) (comps, !pos) c.comp_components; - env := store_module None id path mty !env; + env := store_module None id path mty !env !env; incr pos | Sig_modtype(id, decl) -> let decl' = Subst.modtype_declaration sub decl in c.comp_modtypes <- Tbl.add (Ident.name id) (decl', nopos) c.comp_modtypes; - env := store_modtype None id path decl !env + env := store_modtype None id path decl !env !env | Sig_class(id, decl, _) -> let decl' = Subst.class_declaration sub decl in c.comp_classes <- @@ -1141,13 +1141,13 @@ and check_usage loc id warn tbl = (fun () -> if not !used then Location.prerr_warning loc (warn name)) end; -and store_value ?check slot id path decl env = +and store_value ?check slot id path decl env renv = may (fun f -> check_usage decl.val_loc id f value_declarations) check; { env with - values = EnvTbl.add "value" slot id (path, decl) env.values; + values = EnvTbl.add "value" slot id (path, decl) env.values renv.values; summary = Env_value(env.summary, id, decl) } -and store_type slot id path info env = +and store_type slot id path info env renv = let loc = info.type_loc in check_usage loc id (fun s -> Warnings.Unused_type_declaration s) type_declarations; @@ -1178,28 +1178,28 @@ and store_type slot id path info env = { env with constrs = List.fold_right - (fun (id, descr) constrs -> EnvTbl.add "constructor" slot id descr constrs) + (fun (id, descr) constrs -> EnvTbl.add "constructor" slot id descr constrs renv.constrs) constructors env.constrs; labels = List.fold_right - (fun (id, descr) labels -> EnvTbl.add "label" slot id descr labels) + (fun (id, descr) labels -> EnvTbl.add "label" slot id descr labels renv.labels) labels env.labels; - types = EnvTbl.add "type" slot id (path, (info, descrs)) env.types; + types = EnvTbl.add "type" slot id (path, (info, descrs)) env.types renv.types; summary = Env_type(env.summary, id, info) } -and store_type_infos slot id path info env = +and store_type_infos slot id path info env renv = (* Simplified version of store_type that doesn't compute and store constructor and label infos, but simply record the arity and manifest-ness of the type. Used in components_of_module to keep track of type abbreviations (e.g. type t = float) in the computation of label representations. *) { env with - types = EnvTbl.add "type" slot id (path, (info,([],[]))) env.types; + types = EnvTbl.add "type" slot id (path, (info,([],[]))) env.types renv.types; summary = Env_type(env.summary, id, info) } -and store_exception slot id path decl env = +and store_exception slot id path decl env renv = let loc = decl.exn_loc in if not loc.Location.loc_ghost && Warnings.is_active (Warnings.Unused_exception ("", false)) @@ -1221,30 +1221,30 @@ and store_exception slot id path decl env = end; end; { env with - constrs = EnvTbl.add "constructor" slot id (Datarepr.exception_descr path decl) env.constrs; + constrs = EnvTbl.add "constructor" slot id (Datarepr.exception_descr path decl) env.constrs renv.constrs; summary = Env_exception(env.summary, id, decl) } -and store_module slot id path mty env = +and store_module slot id path mty env renv = { env with - modules = EnvTbl.add "module" slot id (path, mty) env.modules; + modules = EnvTbl.add "module" slot id (path, mty) env.modules renv.modules; components = EnvTbl.add "module" slot id (path, components_of_module env Subst.identity path mty) - env.components; + env.components renv.components; summary = Env_module(env.summary, id, mty) } -and store_modtype slot id path info env = +and store_modtype slot id path info env renv = { env with - modtypes = EnvTbl.add "module type" slot id (path, info) env.modtypes; + modtypes = EnvTbl.add "module type" slot id (path, info) env.modtypes renv.modtypes; summary = Env_modtype(env.summary, id, info) } -and store_class slot id path desc env = +and store_class slot id path desc env renv = { env with - classes = EnvTbl.add "class" slot id (path, desc) env.classes; + classes = EnvTbl.add "class" slot id (path, desc) env.classes renv.classes; summary = Env_class(env.summary, id, desc) } -and store_cltype slot id path desc env = +and store_cltype slot id path desc env renv = { env with - cltypes = EnvTbl.add "class type" slot id (path, desc) env.cltypes; + cltypes = EnvTbl.add "class type" slot id (path, desc) env.cltypes renv.cltypes; summary = Env_cltype(env.summary, id, desc) } (* Compute the components of a functor application in a path. *) @@ -1271,25 +1271,25 @@ let _ = (* Insertion of bindings by identifier *) let add_value ?check id desc env = - store_value None ?check id (Pident id) desc env + store_value None ?check id (Pident id) desc env env let add_type id info env = - store_type None id (Pident id) info env + store_type None id (Pident id) info env env and add_exception id decl env = - store_exception None id (Pident id) decl env + store_exception None id (Pident id) decl env env and add_module id mty env = - store_module None id (Pident id) mty env + store_module None id (Pident id) mty env env and add_modtype id info env = - store_modtype None id (Pident id) info env + store_modtype None id (Pident id) info env env and add_class id ty env = - store_class None id (Pident id) ty env + store_class None id (Pident id) ty env env and add_cltype id ty env = - store_cltype None id (Pident id) ty env + store_cltype None id (Pident id) ty env env let add_local_constraint id info elv env = match info with @@ -1303,7 +1303,7 @@ let add_local_constraint id info elv env = (* Insertion of bindings by name *) let enter store_fun name data env = - let id = Ident.create name in (id, store_fun None id (Pident id) data env) + let id = Ident.create name in (id, store_fun None id (Pident id) data env env) let enter_value ?check = enter (store_value ?check) and enter_type = enter store_type @@ -1332,7 +1332,7 @@ let rec add_signature sg env = (* Open a signature path *) -let open_signature slot root sg env = +let open_signature slot root sg env0 = (* First build the paths and substitution *) let (pl, sub, sg) = prefix_idents_and_subst root Subst.identity sg in let sg = Lazy.force sg in @@ -1344,22 +1344,22 @@ let open_signature slot root sg env = (fun env item p -> match item with Sig_value(id, decl) -> - store_value slot (Ident.hide id) p decl env + store_value slot (Ident.hide id) p decl env env0 | Sig_type(id, decl, _) -> - store_type slot (Ident.hide id) p decl env + store_type slot (Ident.hide id) p decl env env0 | Sig_exception(id, decl) -> - store_exception slot (Ident.hide id) p decl env + store_exception slot (Ident.hide id) p decl env env0 | Sig_module(id, mty, _) -> - store_module slot (Ident.hide id) p mty env + store_module slot (Ident.hide id) p mty env env0 | Sig_modtype(id, decl) -> - store_modtype slot (Ident.hide id) p decl env + store_modtype slot (Ident.hide id) p decl env env0 | Sig_class(id, decl, _) -> - store_class slot (Ident.hide id) p decl env + store_class slot (Ident.hide id) p decl env env0 | Sig_class_type(id, decl, _) -> - store_cltype slot (Ident.hide id) p decl env + store_cltype slot (Ident.hide id) p decl env env0 ) - env sg pl in - { newenv with summary = Env_open(env.summary, root) } + env0 sg pl in + { newenv with summary = Env_open(env0.summary, root) } (* Open a signature from a file *)