Merge pull request #343 from trefis/pr7083

PR7083: fix assertion failure introduced by #305

testsuite/tests/match-exception-warnings/pressure_variants.ml

@@ -0,0 +1,31 @@
+(* Regression testing for PR#7083 *)
+let simple x =
+  match x with
+  | `A -> ()
+  | exception Not_found -> ()
+;;
+
+let moderatly_less_simple x =
+  match x with
+  | `A | exception Exit -> ()
+;;
+
+let less_simple x =
+  match x with
+  | `A | exception Exit -> ()
+  | exception Not_found -> ()
+;;
+
+type t = [ `A | `B ]
+
+let plain_weird x =
+  match x with
+  | #t -> ()
+  | exception Not_found -> ()
+;;
+
+let plain_weird' x =
+  match x with
+  | #t | exception Exit -> ()
+  | exception Not_found -> ()
+;;

testsuite/tests/match-exception-warnings/pressure_variants.ml.reference

@@ -0,0 +1,8 @@
+
+#           val simple : [< `A ] -> unit = <fun>
+#         val moderatly_less_simple : [< `A ] -> unit = <fun>
+#           val less_simple : [< `A ] -> unit = <fun>
+#               type t = [ `A | `B ]
+val plain_weird : [< t ] -> unit = <fun>
+#           val plain_weird' : [< t ] -> unit = <fun>
+# 

typing/parmatch.ml

@@ -533,7 +533,7 @@ let filter_all pat0 pss =
       filter_rec env ((p::ps)::pss)
   | ({pat_desc = Tpat_or(p1,p2,_)}::ps)::pss ->
       filter_rec env ((p1::ps)::(p2::ps)::pss)
-  | ({pat_desc = (Tpat_any | Tpat_var(_))}::_)::pss ->
+  | ({pat_desc = (Tpat_any | Tpat_var(_) | Tpat_exception(_))}::_)::pss ->
       filter_rec env pss
   | (p::ps)::pss ->
       filter_rec (insert p ps env) pss