Fix PR#5815

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13789 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

Changes

@@ -104,6 +104,7 @@ Bug fixes:
 - PR#5806: ensure that backtrace tests are always run (testsuite)
 - PR#5810: error in switch printing when using -dclambda
 - PR#5813: GC not called when unmarshaling repeatedly in a tight loop (ocamlopt)
+- PR#5815: Multiple exceptions in signatures gives an error
 - PR#5819: segfault when using [with] on large recursive record (ocamlopt)
 - PR#5821: Wrong record field is reported as duplicate
 - PR#5824: Generate more efficient code for immediate right shifts.

testsuite/tests/typing-modules/Test.ml

@@ -50,3 +50,7 @@ module M : sig type -'a t = private int end =
 module type A = sig type t = X of int end;;
 type u = X of bool;;
 module type B = A with type t = u;; (* fail *)
+
+(* PR#5815 *)
+
+module type S = sig exception Foo of int  exception Foo of bool end;;

testsuite/tests/typing-modules/Test.ml.principal.reference

@@ -28,4 +28,5 @@ Error: Signature mismatch:
                          ^^^^^^^^^^
 Error: This variant or record definition does not match that of type u
        The types for field X are not equal.
+#       module type S = sig exception Foo of bool end
 # 

testsuite/tests/typing-modules/Test.ml.reference

@@ -28,4 +28,5 @@ Error: Signature mismatch:
                          ^^^^^^^^^^
 Error: This variant or record definition does not match that of type u
        The types for field X are not equal.
+#       module type S = sig exception Foo of bool end
 # 

typing/typemod.ml

@@ -378,17 +378,25 @@ let check_sig_item type_names module_names modtype_names loc = function
       check "module type" loc modtype_names (Ident.name id)
   | _ -> ()
 
-let rec remove_values ids = function
+let rec remove_duplicates val_ids exn_ids  = function
     [] -> []
   | Sig_value (id, _) :: rem
-    when List.exists (Ident.equal id) ids -> remove_values ids rem
-  | f :: rem -> f :: remove_values ids rem
+    when List.exists (Ident.equal id) val_ids -> remove_duplicates val_ids exn_ids rem
+  | Sig_exception(id, _) :: rem
+    when List.exists (Ident.equal id) exn_ids -> remove_duplicates val_ids exn_ids rem
+  | f :: rem -> f :: remove_duplicates val_ids exn_ids rem
 
 let rec get_values = function
     [] -> []
   | Sig_value (id, _) :: rem -> id :: get_values rem
   | f :: rem -> get_values rem
 
+let rec get_exceptions = function
+    [] -> []
+  | Sig_exception (id, _) :: rem -> id :: get_exceptions rem
+  | f :: rem -> get_exceptions rem
+
+
 (* Check and translate a module type expression *)
 
 let transl_modtype_longident loc env lid =
@@ -483,7 +491,8 @@ and transl_signature env sg =
             let (id, newenv) = Env.enter_exception name.txt arg.exn_exn env in
             let (trem, rem, final_env) = transl_sig newenv srem in
             mksig (Tsig_exception (id, name, arg)) env loc :: trem,
-            Sig_exception(id, arg.exn_exn) :: rem,
+            (if List.exists (Ident.equal id) (get_exceptions rem) then rem
+            else Sig_exception(id, arg.exn_exn) :: rem),
             final_env
         | Psig_module(name, smty) ->
             check "module" item.psig_loc module_names name.txt;
@@ -531,7 +540,8 @@ and transl_signature env sg =
             let newenv = Env.add_signature sg env in
             let (trem, rem, final_env) = transl_sig newenv srem in
             mksig (Tsig_include (tmty, sg)) env loc :: trem,
-            remove_values (get_values rem) sg @ rem, final_env
+            remove_duplicates (get_values rem) (get_exceptions rem) sg @ rem,
+            final_env
         | Psig_class cl ->
             List.iter
               (fun {pci_name = name} ->