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

#5601: Shouldn't warn about unused constructors when there is an equation. 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12397 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2012-04-25 07:34:41 +00:00
parent 952fe3d0f2
commit 6e7c62b0b9
3 changed files with 12 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
typing/includecore.ml
View File

@ -200,19 +200,23 @@ let rec compare_records env decl1 decl2 n labels1 labels2 =
then compare_records env decl1 decl2 (n+1) rem1 rem2
else [Field_type lab1]
let type_declarations env name decl1 id decl2 =
let type_declarations ?(equality = false) env name decl1 id decl2 =
if decl1.type_arity <> decl2.type_arity then [Arity] else
if not (private_flags decl1 decl2) then [Privacy] else
let err = match (decl1.type_kind, decl2.type_kind) with
(_, Type_abstract) -> []
| (Type_variant cstrs1, Type_variant cstrs2) ->
let mark cstrs usage name decl =
List.iter
(fun (c, _, _) -> Env.mark_constructor_used usage name decl c)
cstrs
in
let usage =
if decl1.type_private = Private || decl2.type_private = Public
then `Positive else `Privatize
in
List.iter
(fun (c, _, _) -> Env.mark_constructor_used usage name decl1 c)
cstrs1;
mark cstrs1 usage name decl1;
if equality then mark cstrs2 `Positive (Ident.name id) decl2;
compare_variants env decl1 decl2 1 cstrs1 cstrs2
| (Type_record(labels1,rep1), Type_record(labels2,rep2)) ->
let err = compare_records env decl1 decl2 1 labels1 labels2 in

5
typing/includecore.mli
View File

@ -36,8 +36,9 @@ type type_mismatch =
val value_descriptions:
Env.t -> value_description -> value_description -> module_coercion
val type_declarations:
Env.t -> string ->
type_declaration -> Ident.t -> type_declaration -> type_mismatch list
?equality:bool ->
Env.t -> string ->
type_declaration -> Ident.t -> type_declaration -> type_mismatch list
val exception_declarations:
Env.t -> exception_declaration -> exception_declaration -> bool
(*

2
typing/typedecl.ml
View File

@ -359,7 +359,7 @@ let check_abbrev env (_, sdecl) (id, decl) =
else if not (Ctype.equal env false args decl.type_params)
then [Includecore.Constraint]
else
Includecore.type_declarations env
Includecore.type_declarations ~equality:true env
(Path.last path)
decl'
id