fix PR#5057, must adjust levels in row fields
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@10446 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
418b6ed18f
commit
9c79ec9120
1
Changes
1
Changes
|
@ -93,6 +93,7 @@ All tools:
|
|||
- PR#4857: add a -vnum option to display the version number and nothing else
|
||||
|
||||
Bug Fixes:
|
||||
- PR#5057: fatal typing error with local module + functor + polymorphic variant
|
||||
- PR#4742: finalisation function raising an exception blocks other finalisations
|
||||
- PR#4775: compiler crash on crazy types (temporary fix)
|
||||
- PR#4970: better error message for instance variables
|
||||
|
|
|
@ -0,0 +1,14 @@
|
|||
(* PR5057 *)
|
||||
|
||||
module TT = struct
|
||||
module IntSet = Set.Make(struct type t = int let compare = compare end)
|
||||
end
|
||||
|
||||
let () =
|
||||
let f flag =
|
||||
let module T = TT in
|
||||
let _ = match flag with `A -> 0 | `B r -> r in
|
||||
let _ = match flag with `A -> T.IntSet.mem | `B r -> r in
|
||||
()
|
||||
in
|
||||
f `A
|
|
@ -0,0 +1,7 @@
|
|||
(* This one should fail *)
|
||||
|
||||
let f flag =
|
||||
let module T = Set.Make(struct type t = int let compare = compare end) in
|
||||
let _ = match flag with `A -> 0 | `B r -> r in
|
||||
let _ = match flag with `A -> T.mem | `B r -> r in
|
||||
()
|
|
@ -1821,7 +1821,7 @@ and unify_row env row1 row2 =
|
|||
set_more row1 r2;
|
||||
List.iter
|
||||
(fun (l,f1,f2) ->
|
||||
try unify_row_field env row1.row_fixed row2.row_fixed l f1 f2
|
||||
try unify_row_field env row1.row_fixed row2.row_fixed more l f1 f2
|
||||
with Unify trace ->
|
||||
raise (Unify ((mkvariant [l,f1] true,
|
||||
mkvariant [l,f2] true) :: trace)))
|
||||
|
@ -1830,7 +1830,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 l f1 f2 =
|
||||
and unify_row_field env fixed1 fixed2 more 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
|
||||
|
@ -1847,13 +1847,15 @@ and unify_row_field env fixed1 fixed2 l f1 f2 =
|
|||
List.iter (unify env t1) tl;
|
||||
!e1 <> None || !e2 <> None
|
||||
end in
|
||||
if redo then unify_row_field env fixed1 fixed2 l f1 f2 else
|
||||
if redo then unify_row_field env fixed1 fixed2 more l f1 f2 else
|
||||
let tl1 = List.map repr tl1 and tl2 = List.map repr tl2 in
|
||||
let rec remq tl = function [] -> []
|
||||
| ty :: tl' ->
|
||||
if List.memq ty tl then remq tl tl' else ty :: remq tl tl'
|
||||
in
|
||||
let tl2' = remq tl2 tl1 and tl1' = remq tl1 tl2 in
|
||||
(* Is this handling of levels really principal? *)
|
||||
List.iter (update_level env (repr more).level) (tl1' @ tl2');
|
||||
let e = ref None in
|
||||
let f1' = Reither(c1 || c2, tl1', m1 || m2, e)
|
||||
and f2' = Reither(c1 || c2, tl2', m1 || m2, e) in
|
||||
|
|
Loading…
Reference in New Issue