Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Keep attributes on value declarations in .cmi files (but clear all the location fields, except if -keep-locs is used, of course). Use this to report a warning when a value marked as [@@deprecated] is referenced (#5854) 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14188 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2013-09-26 15:24:11 +00:00
parent f55565753e
commit 6873f39817
16 changed files with 46 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Changes
View File

@ -14,6 +14,8 @@ Compilers:
- PR#6182: better message for virtual objects and class types
(Leo P. White, Stephen Dolan)
- PR#5817: new flag to keep locations in cmi files
- PR#5854: issue warning 3 when referring to a value marked with
the [@@deprecated] attribute
Bug fixes:
- PR#4719: Sys.executable_name wrong if executable name contains dots (Windows)

BIN
boot/ocamlc
View File

Binary file not shown.

BIN
boot/ocamldep
View File

Binary file not shown.

BIN
boot/ocamllex
View File

Binary file not shown.

1
bytecomp/translcore.ml
View File

@ -531,6 +531,7 @@ let rec push_defaults loc bindings cases partial =
({exp with exp_type = pat.pat_type; exp_desc =
Texp_ident (Path.Pident param, mknoloc (Longident.Lident name),
{val_type = pat.pat_type; val_kind = Val_reg;
val_attributes = [];
Types.val_loc = Location.none;
})},
cases, partial) }

1
debugger/Makefile.shared
View File

@ -30,6 +30,7 @@ OTHEROBJS=\
../utils/misc.cmo ../utils/config.cmo ../utils/tbl.cmo \
../utils/clflags.cmo ../utils/consistbl.cmo ../utils/warnings.cmo \
../parsing/location.cmo ../parsing/longident.cmo \
../parsing/ast_helper.cmo ../parsing/ast_mapper.cmo \
../typing/ident.cmo ../typing/path.cmo ../typing/types.cmo \
../typing/btype.cmo ../typing/primitive.cmo ../typing/typedtree.cmo \
../typing/subst.cmo ../typing/predef.cmo \

1
ocamldoc/Makefile
View File

@ -153,6 +153,7 @@ OCAMLCMOFILES=$(OCAMLSRCDIR)/parsing/printast.cmo \
$(OCAMLSRCDIR)/parsing/parser.cmo \
$(OCAMLSRCDIR)/parsing/lexer.cmo \
$(OCAMLSRCDIR)/parsing/parse.cmo \
$(OCAMLSRCDIR)/parsing/ast_mapper.cmo \
$(OCAMLSRCDIR)/typing/types.cmo \
$(OCAMLSRCDIR)/typing/path.cmo \
$(OCAMLSRCDIR)/typing/btype.cmo \

2
otherlibs/dynlink/Makefile
View File

@ -28,6 +28,8 @@ COMPILEROBJS=\
../../utils/terminfo.cmo ../../utils/warnings.cmo \
../../parsing/asttypes.cmi \
../../parsing/location.cmo ../../parsing/longident.cmo \
../../parsing/ast_helper.cmo \
../../parsing/ast_mapper.cmo \
../../typing/ident.cmo ../../typing/path.cmo \
../../typing/primitive.cmo ../../typing/types.cmo \
../../typing/btype.cmo ../../typing/subst.cmo ../../typing/predef.cmo \

1
tools/Makefile.shared
View File

@ -211,6 +211,7 @@ READ_CMT= \
../parsing/lexer.cmo \
../parsing/pprintast.cmo \
../parsing/ast_helper.cmo \
../parsing/ast_mapper.cmo \
../typing/ident.cmo \
../typing/path.cmo \
../typing/types.cmo \

7
typing/mtype.ml
View File

@ -108,10 +108,9 @@ let nondep_supertype env mid mty =
let rem' = nondep_sig env va rem in
match item with
Sig_value(id, d) ->
Sig_value(id, {val_type = Ctype.nondep_type env mid d.val_type;
val_kind = d.val_kind;
val_loc = d.val_loc;
}) :: rem'
Sig_value(id,
{d with val_type = Ctype.nondep_type env mid d.val_type})
:: rem'
| Sig_type(id, d, rs) ->
Sig_type(id, Ctype.nondep_type_decl env mid id (va = Co) d, rs)
:: rem'

8
typing/subst.ml
View File

@ -250,10 +250,18 @@ let class_type s cty =
cleanup_types ();
cty
let remove_loc =
let open Ast_mapper in
{default_mapper with location = (fun _this _loc -> Location.none)}
let value_description s descr =
{ val_type = type_expr s descr.val_type;
val_kind = descr.val_kind;
val_loc = loc s descr.val_loc;
val_attributes =
if s.for_saving && not !Clflags.keep_locs
then remove_loc.Ast_mapper.attributes remove_loc descr.val_attributes
else descr.val_attributes;
}
let exception_declaration s descr =

4
typing/typeclass.ml
View File

@ -202,12 +202,15 @@ let rc node =
let enter_met_env ?check loc lab kind ty val_env met_env par_env =
let (id, val_env) =
Env.enter_value lab {val_type = ty; val_kind = Val_unbound;
val_attributes = [];
Types.val_loc = loc} val_env
in
(id, val_env,
Env.add_value ?check id {val_type = ty; val_kind = kind;
val_attributes = [];
Types.val_loc = loc} met_env,
Env.add_value id {val_type = ty; val_kind = Val_unbound;
val_attributes = [];
Types.val_loc = loc} par_env)
(* Enter an instance variable in the environment *)
@ -1081,6 +1084,7 @@ and class_expr cl_num val_env met_env scl =
let desc =
{val_type = expr.exp_type; val_kind = Val_ivar (Immutable,
cl_num);
val_attributes = [];
Types.val_loc = vd.Types.val_loc;
}
in

18
typing/typecore.ml
View File

@ -1230,7 +1230,9 @@ let add_pattern_variables ?check ?check_as env =
(fun (id, ty, name, loc, as_var) env ->
let check = if as_var then check_as else check in
Env.add_value ?check id
{val_type = ty; val_kind = Val_reg; Types.val_loc = loc} env
{val_type = ty; val_kind = Val_reg; Types.val_loc = loc;
val_attributes = [];
} env
)
pv env,
get_ref module_variables)
@ -1272,6 +1274,7 @@ let type_class_arg_pattern cl_num val_env met_env l spat =
((id', name, id, ty)::pv,
Env.add_value id' {val_type = ty;
val_kind = Val_ivar (Immutable, cl_num);
val_attributes = [];
Types.val_loc = loc;
} ~check
env))
@ -1299,16 +1302,19 @@ let type_self_pattern cl_num privty val_env met_env par_env spat =
(fun (id, ty, name, loc, as_var) (val_env, met_env, par_env) ->
(Env.add_value id {val_type = ty;
val_kind = Val_unbound;
val_attributes = [];
Types.val_loc = loc;
} val_env,
Env.add_value id {val_type = ty;
val_kind = Val_self (meths, vars, cl_num, privty);
val_attributes = [];
Types.val_loc = loc;
}
~check:(fun s -> if as_var then Warnings.Unused_var s
else Warnings.Unused_var_strict s)
met_env,
Env.add_value id {val_type = ty; val_kind = Val_unbound;
val_attributes = [];
Types.val_loc = loc;
} par_env))
pv (val_env, met_env, par_env)
@ -1907,6 +1913,13 @@ and type_expect_ ?in_function env sexp ty_expected =
let name = Path.name ~paren:Oprint.parenthesized_ident path in
Stypes.record (Stypes.An_ident (loc, name, annot))
end;
if
List.exists
(function ({txt = "deprecated"; _}, _) -> true | _ -> false)
desc.val_attributes
then
Location.prerr_warning loc (Warnings.Deprecated (Path.name path));
rue {
exp_desc =
begin match desc.val_kind with
@ -2302,6 +2315,7 @@ and type_expect_ ?in_function env sexp ty_expected =
let high = type_expect env shigh Predef.type_int in
let (id, new_env) =
Env.enter_value param.txt {val_type = instance_def Predef.type_int;
val_attributes = [];
val_kind = Val_reg; Types.val_loc = loc; } env
~check:(fun s -> Warnings.Unused_for_index s)
in
@ -2460,6 +2474,7 @@ and type_expect_ ?in_function env sexp ty_expected =
Texp_ident(Path.Pident method_id, lid,
{val_type = method_type;
val_kind = Val_reg;
val_attributes = [];
Types.val_loc = Location.none});
exp_loc = loc; exp_extra = [];
exp_type = method_type;
@ -2952,6 +2967,7 @@ and type_argument env sarg ty_expected' ty_expected =
exp_desc =
Texp_ident(Path.Pident id, mknoloc (Longident.Lident name),
{val_type = ty; val_kind = Val_reg;
val_attributes = [];
Types.val_loc = Location.none})}
in
let eta_pat, eta_var = var_pair "eta" ty_arg in

6
typing/typedecl.ml
View File

@ -1047,7 +1047,8 @@ let transl_value_decl env loc valdecl =
let v =
match valdecl.pval_prim with
[] ->
{ val_type = ty; val_kind = Val_reg; Types.val_loc = loc }
{ val_type = ty; val_kind = Val_reg; Types.val_loc = loc;
val_attributes = valdecl.pval_attributes }
| decl ->
let arity = Ctype.arity ty in
if arity = 0 then
@ -1057,7 +1058,8 @@ let transl_value_decl env loc valdecl =
&& prim.prim_arity > 5
&& prim.prim_native_name = ""
then raise(Error(valdecl.pval_type.ptyp_loc, Missing_native_external));
{ val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc }
{ val_type = ty; val_kind = Val_prim prim; Types.val_loc = loc;
val_attributes = valdecl.pval_attributes }
in
let (id, newenv) =
Env.enter_value valdecl.pval_name.txt v env

1
typing/types.ml
View File

@ -87,6 +87,7 @@ type value_description =
{ val_type: type_expr; (* Type of the value *)
val_kind: value_kind;
val_loc: Location.t;
val_attributes: Parsetree.attributes;
}
and value_kind =

1
typing/types.mli
View File

@ -85,6 +85,7 @@ type value_description =
{ val_type: type_expr; (* Type of the value *)
val_kind: value_kind;
val_loc: Location.t;
val_attributes: Parsetree.attributes;
}
and value_kind =