allow absent constructors in PM for non-exact polymorphic variant types

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

Changes

@@ -4,10 +4,10 @@ Next version
 (Changes that can break existing programs are marked with a "*")
 
 Type system:
-- Propagate type information towards pattern-matching, even in the presence of
+* Propagate type information towards pattern-matching, even in the presence of
   polymorphic variants (discarding only information about possibly-present
   constructors). As a result, matching against absent constructors is no longer
-  allowed.
+  allowed for exact and fixed polymorphic variant types.
 
 Compilers:
 - PR#5861: raise an error when multiple private keywords are used in type

testsuite/tests/typing-misc/polyvars.ml

@@ -2,3 +2,6 @@ type ab = [ `A | `B ];;
 let f (x : [`A]) = match x with #ab -> 1;;
 let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);;
 let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);;
+
+let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)

testsuite/tests/typing-misc/polyvars.ml.principal.reference

@@ -18,4 +18,15 @@ Error: This pattern matches values of type [? `B ]
 Error: This pattern matches values of type [? `B ]
        but a pattern was expected which matches values of type [ `A ]
        Types for tag `B are incompatible
+#   Characters 50-52:
+  let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+                                                   ^^
+Warning 12: this sub-pattern is unused.
+val f : [< `A | `B ] -> int = <fun>
+# Characters 47-49:
+  let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+                                                 ^^
+Error: This pattern matches values of type [? `C ]
+       but a pattern was expected which matches values of type [ `A | `B ]
+       The second variant type does not allow tag(s) `C
 # 

testsuite/tests/typing-misc/polyvars.ml.reference

@@ -18,4 +18,15 @@ Error: This pattern matches values of type [? `B ]
 Error: This pattern matches values of type [? `B ]
        but a pattern was expected which matches values of type [ `A ]
        The second variant type does not allow tag(s) `B
+#   Characters 50-52:
+  let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *)
+                                                   ^^
+Warning 12: this sub-pattern is unused.
+val f : [< `A | `B ] -> int = <fun>
+# Characters 47-49:
+  let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *)
+                                                 ^^
+Error: This pattern matches values of type [? `C ]
+       but a pattern was expected which matches values of type [ `A | `B ]
+       The second variant type does not allow tag(s) `C
 # 

typing/typecore.ml

@@ -1719,6 +1719,7 @@ let check_absent_variant env =
       let row = row_repr !row in
       if List.exists (fun (s',fi) -> s = s' && row_field_repr fi <> Rabsent)
           row.row_fields
+      || not row.row_fixed && not (static_row row)  (* same as Ctype.poly *)
       then () else
       let ty_arg =
         match arg with None -> [] | Some p -> [correct_levels p.pat_type] in