ocaml#5601: Shouldn't warn about unused constructors when there is an…

… equation. (Cheery-picked from trunk commit 12397.) git-svn-id: http://caml.inria.fr/svn/ocaml/version/4.00@12398 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
dra27 · Apr 25, 2012 · 55a266b · 55a266b
1 parent 63578b1
commit 55a266b
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 7 deletions.
diff --git a/typing/includecore.ml b/typing/includecore.ml
@@ -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

diff --git a/typing/includecore.mli b/typing/includecore.mli
@@ -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
 (*

diff --git a/typing/typedecl.ml b/typing/typedecl.ml
@@ -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