Fix PR#5560

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

Changes

@@ -125,6 +125,7 @@ Bug Fixes:
 - PR#5511: in Bigarray.reshape, unwarranted limitation on new array dimensions.
 - PR#5513: Int64.div causes floating point exception (ocamlopt, x86)
 - PR#5516: in Bigarray C stubs, use C99 / GCC flexible array types if possible
+- PR#5560: incompatible type for tuple pattern with -principal
 - problem with printing of string literals in camlp4 (reported on caml-list)
 - emacs mode: colorization of comments and strings now works correctly
 

testsuite/tests/typing-poly/poly.ml

@@ -643,3 +643,11 @@ module Polux = struct
   class alias = object method alias : 'a . 'a t -> 'a = ident end
   let f (x : <m : 'a. 'a t>) = (x : <m : 'a. 'a>)
 end;;
+
+(* PR#5560 *)
+
+let (a, b) = (raise Exit : int * int);;
+type t = { foo : int }
+let {foo} = (raise Exit : t);;
+type s = A of int
+let (A x) = (raise Exit : s);;

testsuite/tests/typing-poly/poly.ml.principal.reference

@@ -632,4 +632,7 @@ Error: This field value has type unit -> unit which is less general than
     class alias : object method alias : 'a t -> 'a end
     val f : < m : 'a. 'a t > -> < m : 'a. 'a >
   end
+#       Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
 # 

testsuite/tests/typing-poly/poly.ml.reference

@@ -595,4 +595,7 @@ Error: This field value has type unit -> unit which is less general than
     class alias : object method alias : 'a t -> 'a end
     val f : < m : 'a. 'a t > -> < m : 'a. 'a >
   end
+#       Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
+#   Exception: Pervasives.Exit.
 # 

typing/typecore.ml

@@ -2772,9 +2772,7 @@ and type_let ?(check = fun s -> Warnings.Unused_var s)
         | _, Pexp_constraint (_, Some sty, None) when !Clflags.principal ->
             (* propagate type annotation to pattern,
                to allow it to be generalized in -principal mode *)
-            {ppat_desc = Ppat_constraint
-               (spat, {ptyp_desc=Ptyp_poly([],sty);
-                       ptyp_loc={sty.ptyp_loc with Location.loc_ghost=true}});
+            {ppat_desc = Ppat_constraint (spat, sty);
              ppat_loc = {spat.ppat_loc with Location.loc_ghost=true}}
         | _ -> spat)
       spat_sexp_list in