#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-0dff7051ff02master
Alain Frisch
parent
9f55c9cbd5
commit
4f24f8ab0f
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 *)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue