fix bug of non-shared field_kind

Changes

@@ -104,6 +104,12 @@ Working version
   otherwise the derived pointer is live across a poll point.
   (Vincent Laviron and Xavier Leroy, review by Xavier Leroy and Sadiq Jaffer)
 
+- #10539: Field kinds should be kept when copying types
+  Losing the sharing meant that one could desynchronize them between several
+  occurences of self, allowing a method to be both public and hidden,
+  which broke type soundness.
+  (Jacques Garrigue)
+
 - #10542: Fix detection of immediate64 types through unboxed types.
   (Leo White, review by Stephen Dolan and Gabriel Scherer)
 

testsuite/tests/typing-objects/field_kind.ml

@@ -0,0 +1,73 @@
+(* TEST
+   * expect
+*)
+
+type _ t = Int : int t;;
+[%%expect{|
+type _ t = Int : int t
+|}]
+
+let o =
+  object (self)
+    method private x = 3
+    method m : type a. a t -> a = fun Int -> (self#x : int)
+  end;;
+[%%expect{|
+val o : < m : 'a. 'a t -> 'a > = <obj>
+|}]
+
+let o' =
+  object (self : 's)
+    method private x = 3
+    method m : type a. a t -> 's -> a = fun Int other -> (other#x : int)
+  end;;
+
+let aargh = assert (o'#m Int o' = 3);;
+[%%expect{|
+Lines 2-5, characters 2-5:
+2 | ..object (self : 's)
+3 |     method private x = 3
+4 |     method m : type a. a t -> 's -> a = fun Int other -> (other#x : int)
+5 |   end..
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ x.
+val o' : < m : 'a. 'a t -> 'b -> 'a; x : int > as 'b = <obj>
+val aargh : unit = ()
+|}]
+
+let o2 =
+  object (self : 's)
+    method private x = 3
+    method m : 's -> int = fun other -> (other#x : int)
+  end;;
+[%%expect{|
+Lines 2-5, characters 2-5:
+2 | ..object (self : 's)
+3 |     method private x = 3
+4 |     method m : 's -> int = fun other -> (other#x : int)
+5 |   end..
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ x.
+val o2 : < m : 'a -> int; x : int > as 'a = <obj>
+|}]
+
+let o3 =
+  object (self : 's)
+    method private x = 3
+    method m : 's -> int = fun other ->
+      let module M = struct let other = other end in (M.other#x : int)
+  end;;
+
+let aargh = assert (o3#m o3 = 3);;
+[%%expect{|
+Lines 2-6, characters 2-5:
+2 | ..object (self : 's)
+3 |     method private x = 3
+4 |     method m : 's -> int = fun other ->
+5 |       let module M = struct let other = other end in (M.other#x : int)
+6 |   end..
+Warning 15 [implicit-public-methods]: the following private methods were made public implicitly:
+ x.
+val o3 : < m : 'a -> int; x : int > as 'a = <obj>
+val aargh : unit = ()
+|}]

typing/btype.ml

@@ -477,7 +477,7 @@ let rec copy_type_desc ?(keep_names=false) f = function
   | Tobject (ty, _)     -> Tobject (f ty, ref None)
   | Tvariant _          -> assert false (* too ambiguous *)
   | Tfield (p, k, ty1, ty2) -> (* the kind is kept shared *)
-      Tfield (p, copy_kind k, f ty1, f ty2)
+      Tfield (p, field_kind_repr k, f ty1, f ty2)
   | Tnil                -> Tnil
   | Tlink ty            -> copy_type_desc f (get_desc ty)
   | Tsubst _            -> assert false