merge changes between 3.10.2 and the end of branch 3.10

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

3 files changed, 16 insertions, 4 deletions

diff --git a/bytecomp/translclass.ml b/bytecomp/translclass.ml
index d186bdebfb..cf5783a979 100644
--- a/bytecomp/translclass.ml
+++ b/bytecomp/translclass.ml
@@ -607,12 +607,20 @@ let transl_class ids cl_id arity pub_meths cl vflag =
   let meth_ids = get_class_meths cl in
   let subst env lam i0 new_ids' =
     let fv = free_variables lam in
+    (* prerr_ids "cl_id =" [cl_id]; prerr_ids "fv =" (IdentSet.elements fv); *)
     let fv = List.fold_right IdentSet.remove !new_ids' fv in
-    let fv = IdentSet.filter (fun id -> List.mem id new_ids) fv in
-    (* need to handle methods specially (PR#3576) *)
-    let fm = IdentSet.diff (free_methods lam) meth_ids in
-    let fv = IdentSet.union fv fm in
+    (* We need to handle method ids specially, as they do not appear
+       in the typing environment (PR#3576, PR#4560) *)
+    (* very hacky: we add and remove free method ids on the fly,
+       depending on the visit order... *)
+    method_ids :=
+      IdentSet.diff (IdentSet.union (free_methods lam) !method_ids) meth_ids;
+    (* prerr_ids "meth_ids =" (IdentSet.elements meth_ids);
+       prerr_ids "method_ids =" (IdentSet.elements !method_ids); *)
+    let new_ids = List.fold_right IdentSet.add new_ids !method_ids in
+    let fv = IdentSet.inter fv new_ids in
     new_ids' := !new_ids' @ IdentSet.elements fv;
+    (* prerr_ids "new_ids' =" !new_ids'; *)
     let i = ref (i0-1) in
     List.fold_left
       (fun subst id ->
diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml
index 9899e44b3e..e97fbfc13d 100644
--- a/bytecomp/translobj.ml
+++ b/bytecomp/translobj.ml
@@ -123,6 +123,7 @@ let transl_store_label_init glob size f arg =
 let wrapping = ref false
 let top_env = ref Env.empty
 let classes = ref []
+let method_ids = ref IdentSet.empty
 
 let oo_add_class id =
   classes := id :: !classes;
@@ -138,6 +139,7 @@ let oo_wrap env req f x =
     cache_required := req;
     top_env := env;
     classes := [];
+    method_ids := IdentSet.empty;
     let lambda = f x in
     let lambda =
       List.fold_left
diff --git a/bytecomp/translobj.mli b/bytecomp/translobj.mli
index d6e432da5c..26fa504b45 100644
--- a/bytecomp/translobj.mli
+++ b/bytecomp/translobj.mli
@@ -24,5 +24,7 @@ val transl_label_init: lambda -> lambda
 val transl_store_label_init:
     Ident.t -> int -> ('a -> lambda) -> 'a -> int * lambda
 
+val method_ids: IdentSet.t ref (* reset when starting a new wrapper *)
+
 val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
 val oo_add_class: Ident.t -> Env.t * bool