better message for PR#1884

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

1 files changed, 19 insertions, 11 deletions

diff --git a/typing/ctype.ml b/typing/ctype.ml
index db972546f3..471f23e535 100644
--- a/typing/ctype.ml
+++ b/typing/ctype.ml
@@ -1649,19 +1649,26 @@ and unify_row env row1 row2 =
   begin try
     set_more row1 r2;
     set_more row2 r1;
+    let undo = ref [] in
     List.iter
       (fun (l,f1,f2) ->
-        unify_row_field env row1.row_fixed row2.row_fixed f1 f2)
+        unify_row_field env row1.row_fixed row2.row_fixed undo l f1 f2)
       pairs;
     (* Special case when there is only one field left *)
     if row0.row_closed then begin
       match filter_row_fields false (row_repr row1).row_fields with [l, fi] ->
         begin match row_field_repr fi with
-          Reither(c, t1::tl, _, e) ->
-            if c then raise (Unify []);
-            set_row_field e (Rpresent (Some t1));
-            (try List.iter (unify env t1) tl
-            with exn -> e := None; raise exn)
+          Reither(c, t1::tl, _, e) as f1 ->
+            let f1' = Rpresent (Some t1) in
+            set_row_field e f1';
+            begin try
+              if c then raise (Unify []);
+              List.iter (unify env t1) tl
+            with exn ->
+              e := None;
+              List.assoc l !undo := Some f1';
+              raise exn
+            end
         | Reither(true, [], _, e) ->
             set_row_field e (Rpresent None);
         | _ -> ()
@@ -1672,7 +1679,7 @@ and unify_row env row1 row2 =
     log_type rm1; rm1.desc <- md1; log_type rm2; rm2.desc <- md2; raise exn
   end
 
-and unify_row_field env fixed1 fixed2 f1 f2 =
+and unify_row_field env fixed1 fixed2 undo l f1 f2 =
   let f1 = row_field_repr f1 and f2 = row_field_repr f2 in
   if f1 == f2 then () else
   match f1, f2 with
@@ -1688,7 +1695,7 @@ and unify_row_field env fixed1 fixed2 f1 f2 =
             List.iter (unify env t1) tl;
             !e1 <> None || !e2 <> None
         end in
-      if redo then unify_row_field env fixed1 fixed2 f1 f2 else
+      if redo then unify_row_field env fixed1 fixed2 undo l f1 f2 else
       let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
       let rec remq tl = function [] -> []
         | ty :: tl' ->
@@ -1696,9 +1703,10 @@ and unify_row_field env fixed1 fixed2 f1 f2 =
       in
       let tl2' = remq tl2 tl1 and tl1' = remq tl1 tl2 in
       let e = ref None in
-      let f1 = Reither(c1 || c2, tl1', m1 || m2, e)
-      and f2 = Reither(c1 || c2, tl2', m1 || m2, e) in
-      set_row_field e1 f1; set_row_field e2 f2
+      let f1' = Reither(c1 || c2, tl1', m1 || m2, e)
+      and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in
+      set_row_field e1 f1'; set_row_field e2 f2';
+      undo := (l, e2) :: !undo
   | Reither(_, _, false, e1), Rabsent -> set_row_field e1 f2
   | Rabsent, Reither(_, _, false, e2) -> set_row_field e2 f1
   | Rabsent, Rabsent -> ()