bug 342 (records dans les orpats)

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

3 files changed, 41 insertions, 8 deletions

diff --git a/bytecomp/matching.ml b/bytecomp/matching.ml
index ceee5810c9..eb843c0502 100644
--- a/bytecomp/matching.ml
+++ b/bytecomp/matching.ml
@@ -433,7 +433,7 @@ let simplify_or p =
 exception Not_simple
 
 let rec raw_rec env = function
-  | Llet(Alias,x,ex, body) -> raw_rec ((x,ex)::env) body
+  | Llet(Alias,x,ex, body) -> raw_rec ((x,raw_rec env ex)::env) body
   | Lvar id as l ->
       begin try List.assoc id env with
       | Not_found -> l
@@ -496,7 +496,17 @@ let rec what_is_or = function
   | {pat_desc = (Tpat_alias (p,_))} -> what_is_or p        
   | {pat_desc=(Tpat_var _|Tpat_any)} -> fatal_error "Matching.what_is_or"
   | p -> p
-  
+
+let rec all_record_pat pat = match pat.pat_desc  with
+  | Tpat_alias (p,x) ->
+      {pat with pat_desc = Tpat_alias (all_record_pat p,x)}
+  | Tpat_or (p,q) ->
+      {pat with pat_desc = Tpat_or (all_record_pat p, all_record_pat q)}
+  | Tpat_record lbls ->
+      let all_lbls = all_record_args lbls in
+      {pat with pat_desc=Tpat_record all_lbls}
+  | _ -> assert false
+
 let simplify_matching m = match m.args with
 | [] -> omega,m
 | (arg, _) :: _ ->
@@ -519,17 +529,26 @@ let simplify_matching m = match m.args with
               (omega :: patl, action)::
               simplify rem
           | Tpat_record lbls ->
-              record_ex_pat pat ;
               let all_lbls = all_record_args lbls in
-              ({pat with pat_desc=Tpat_record all_lbls}::patl,action)::
+              let full_pat = {pat with pat_desc=Tpat_record all_lbls} in
+              record_ex_pat full_pat ;
+              (full_pat::patl,action)::
               simplify rem
           | Tpat_or (_,_) ->
               let pat_simple  = simplify_or pat in
               begin match pat_simple.pat_desc with
               | Tpat_or (_,_) ->
-                  record_ex_pat (what_is_or pat_simple) ;
-                  (pat_simple :: patl, action) ::
-                  simplify rem
+                  let ex_pat = what_is_or pat_simple in
+                  begin match ex_pat.pat_desc with
+                  | Tpat_record _ ->
+                      record_ex_pat (all_record_pat ex_pat) ;
+                      (all_record_pat pat_simple :: patl, action) ::
+                      simplify rem
+                  | _ ->
+                      record_ex_pat ex_pat ;
+                      (pat_simple :: patl, action) ::
+                      simplify rem
+                  end
               | _ ->
                   simplify ((pat_simple::patl,action) :: rem)
               end
diff --git a/test/Moretest/morematch.ml b/test/Moretest/morematch.ml
index 0ac0e9f749..ce857d60d3 100644
--- a/test/Moretest/morematch.ml
+++ b/test/Moretest/morematch.ml
@@ -707,3 +707,17 @@ test"vars2" vars2 [1;2] 2 ;
 test"vars2" vars2 [1;2;3] 3 ;
 test"vars2" vars2 [0 ; 0] 0 ; ()
 ;;
+
+(* Bug 342 *)
+type eber = {x:int; y: int; z:bool}
+
+let eber = function
+  | {x=a; z=true}
+  | {y=a; z=false} -> a
+;;
+
+test "eber" eber {x=0 ; y=1 ; z=true} 0 ;
+test "eber" eber {x=1 ; y=0 ; z=false} 0 ; ()
+;;
+
+
diff --git a/typing/parmatch.ml b/typing/parmatch.ml
index 19bfd949ab..7310e579ad 100644
--- a/typing/parmatch.ml
+++ b/typing/parmatch.ml
@@ -794,7 +794,7 @@ let rec pretty_val ppf v = match v.pat_desc with
         (pretty_lvals (get_record_labels v.pat_type v.pat_env))
         (List.filter
            (function
-             | (_,{pat_desc=Tpat_any}) -> false
+             | (_,{pat_desc=Tpat_any}) -> false (* do not show lbl=_ *)
              | _ -> true) lvs)
   | Tpat_array vs ->
       fprintf ppf "@[[| %a |]@]" (pretty_vals " ;") vs