diff options
author | alainfrisch <alain@frisch.fr> | 2017-07-12 10:40:46 +0200 |
---|---|---|
committer | alainfrisch <alain@frisch.fr> | 2017-07-12 10:43:48 +0200 |
commit | 9329fc73409064130381815ca8e05ae926418c5d (patch) | |
tree | c54c830e757f8d8e90d634d4fcd11274ab865b78 | |
parent | 1747a2f0ebdda531e7bfa78c23cfc2a8e4e6b5e6 (diff) | |
download | ocaml-no_internal_deprecation.tar.gz |
Deprecated type declarations are not reported when accessed from the current sig/struct.no_internal_deprecation
-rwxr-xr-x | parsing/builtin_attributes.ml | 7 | ||||
-rwxr-xr-x | parsing/builtin_attributes.mli | 2 | ||||
-rw-r--r-- | typing/typedecl.ml | 29 |
3 files changed, 36 insertions, 2 deletions
diff --git a/parsing/builtin_attributes.ml b/parsing/builtin_attributes.ml index bfd6ccc626..49841e2a68 100755 --- a/parsing/builtin_attributes.ml +++ b/parsing/builtin_attributes.ml @@ -62,6 +62,13 @@ let rec error_of_extension ext = let cat s1 s2 = if s2 = "" then s1 else s1 ^ "\n" ^ s2 +let partition_deprecated_attrs = + List.partition + (function + | ({txt = "ocaml.deprecated"|"deprecated"; _}, _) -> true + | _ -> false + ) + let rec deprecated_of_attrs = function | [] -> None | ({txt = "ocaml.deprecated"|"deprecated"; _}, p) :: _ -> diff --git a/parsing/builtin_attributes.mli b/parsing/builtin_attributes.mli index 0c645f61ef..927d370e70 100755 --- a/parsing/builtin_attributes.mli +++ b/parsing/builtin_attributes.mli @@ -32,6 +32,8 @@ val check_deprecated: Location.t -> Parsetree.attributes -> string -> unit val check_deprecated_inclusion: def:Location.t -> use:Location.t -> Location.t -> Parsetree.attributes -> Parsetree.attributes -> string -> unit +val partition_deprecated_attrs: + Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes val deprecated_of_attrs: Parsetree.attributes -> string option val deprecated_of_sig: Parsetree.signature -> string option val deprecated_of_str: Parsetree.structure -> string option diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 3491679dcb..0cac474a9a 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -1211,7 +1211,26 @@ let transl_type_decl env rec_flag sdecl_list = fixed_types @ sdecl_list in - + (* Remove @@ocaml.deprecated attributes from the type-checked + declarations so that references to deprecated types in the + current signature/structure does not trigger the deprecation + warning. The attributes will be added back to the final + declarations, which will be the ones visible from outside the + current signature/structure. + + See MPR#7005 + *) + let sdecl_list, deprecated = + List.map + (fun sdecl -> + let (deprecated, others) = + Builtin_attributes.partition_deprecated_attrs sdecl.ptype_attributes + in + {sdecl with ptype_attributes = others}, deprecated + ) + sdecl_list + |> List.split + in (* Create identifiers. *) let id_list = List.map (fun sdecl -> Ident.create sdecl.ptype_name.txt) sdecl_list @@ -1325,10 +1344,16 @@ let transl_type_decl env rec_flag sdecl_list = in (* Check re-exportation *) List.iter2 (check_abbrev final_env) sdecl_list final_decls; + (* Restore ocaml.deprecated attributes on returned declarations *) + let final_decls = + List.map2 + (fun (_id, decl) attrs -> {decl with type_attributes = attrs @ decl.type_attributes}) + final_decls deprecated + in (* Keep original declaration *) let final_decls = List.map2 - (fun tdecl (_id2, decl) -> + (fun tdecl decl -> { tdecl with typ_type = decl } ) tdecls final_decls in |