diff options
| author | Alain Frisch <alain@frisch.fr> | 2012-04-12 17:21:39 +0000 |
|---|---|---|
| committer | Alain Frisch <alain@frisch.fr> | 2012-04-12 17:21:39 +0000 |
| commit | 44cdb206704b267e33e64df03c1b66db1960cdfd (patch) | |
| tree | d1156a9d9c2d1462221e07561e5251dcef3c6234 | |
| parent | 7fa1f303c75509296f5dad9eaae3a49e1fe36373 (diff) | |
| download | ocaml-44cdb206704b267e33e64df03c1b66db1960cdfd.tar.gz | |
Fix #5588.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12348 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
| -rw-r--r-- | typing/includecore.ml | 3 | ||||
| -rw-r--r-- | typing/includecore.mli | 4 | ||||
| -rw-r--r-- | typing/includemod.ml | 2 | ||||
| -rw-r--r-- | typing/typedecl.ml | 4 |
4 files changed, 7 insertions, 6 deletions
diff --git a/typing/includecore.ml b/typing/includecore.ml index 23c715f4df..972102af88 100644 --- a/typing/includecore.ml +++ b/typing/includecore.ml @@ -200,13 +200,12 @@ 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 id decl1 decl2 = +let type_declarations 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 name = Ident.name id in if decl1.type_private = Private || decl2.type_private = Public then List.iter (fun (c, _, _) -> Env.mark_constructor_used name decl1 c) diff --git a/typing/includecore.mli b/typing/includecore.mli index 66bd04c310..17515a8e20 100644 --- a/typing/includecore.mli +++ b/typing/includecore.mli @@ -36,8 +36,8 @@ type type_mismatch = val value_descriptions: Env.t -> value_description -> value_description -> module_coercion val type_declarations: - Env.t -> Ident.t -> - type_declaration -> type_declaration -> type_mismatch list + Env.t -> string -> + type_declaration -> Ident.t -> type_declaration -> type_mismatch list val exception_declarations: Env.t -> exception_declaration -> exception_declaration -> bool (* diff --git a/typing/includemod.ml b/typing/includemod.ml index 4cc2904087..f1e87f55ac 100644 --- a/typing/includemod.ml +++ b/typing/includemod.ml @@ -63,7 +63,7 @@ let value_descriptions env cxt subst id vd1 vd2 = let type_declarations env cxt subst id decl1 decl2 = Env.mark_type_used (Ident.name id) decl1; let decl2 = Subst.type_declaration subst decl2 in - let err = Includecore.type_declarations env id decl1 decl2 in + let err = Includecore.type_declarations env (Ident.name id) decl1 id decl2 in if err <> [] then raise(Error[cxt, Type_declarations(id, decl1, decl2, err)]) (* Inclusion between exception declarations *) diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 3f483c8df0..307d5041b5 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -359,8 +359,10 @@ 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 id + Includecore.type_declarations env + (Path.last path) decl' + id (Subst.type_declaration (Subst.add_type id path Subst.identity) decl) in |