Merge pull request #10764 from alainfrisch/afrisch_fix_oo_compil

Fix miscompilation of method delegation

Changes

@@ -417,6 +417,8 @@ OCaml 4.14.0
 - #10735: Uncaught unify exception from `build_as_type`
   (Jacques Garrigue, report and review by Leo White)
 
+- #10763, #10764: fix miscompilation of method delegation
+  (Alain Frisch, review by Vincent Laviron and Jacques Garrigue)
 
 
 OCaml 4.13 maintenance branch

lambda/translclass.ml

@@ -529,20 +529,13 @@ let transl_class_rebind ~scopes cl vf =
 
 (* Rewrite a closure using builtins. Improves native code size. *)
 
-let rec module_path = function
-    Lvar id ->
-      let s = Ident.name id in s <> "" && s.[0] >= 'A' && s.[0] <= 'Z'
-  | Lprim(Pfield _, [p], _)    -> module_path p
-  | Lprim(Pgetglobal _, [], _) -> true
-  | _                          -> false
-
 let const_path local = function
     Lvar id -> not (List.mem id local)
   | Lconst _ -> true
   | Lfunction {kind = Curried; body} ->
       let fv = free_variables body in
       List.for_all (fun x -> not (Ident.Set.mem x fv)) local
-  | p -> module_path p
+  | _ -> false
 
 let rec builtin_meths self env env2 body =
   let const_path = const_path (env::self) in

testsuite/tests/basic/objects.ml

@@ -0,0 +1,14 @@
+(* TEST *)
+
+
+(* Non-regression for bug #10763, fixed in #10764 *)
+
+module W = struct
+  let r = ref (object method m x = Printf.printf "BAD %i\n%!" x end)
+end
+
+let proxy = object method m = (!W.r) # m end
+
+let () =
+  W.r := object method m x = Printf.printf "OK %i\n%!" x end;
+  proxy # m 3

testsuite/tests/basic/objects.reference

@@ -0,0 +1 @@
+OK 3