Refuse coercing another type into a private record or variant

Why:
    A private type's values can only be built in the module that defines
    it, but structural coercion built them anywhere: a plain record, another
    module's private record with the same fields, a variant, a polymorphic
    variant or a string coerced into a private record or variant (#9124).

`subtype_rec` refuses a coercion whose target's definition is a private
record or variant unless the source is that same type. Coercing out of a
private type is unchanged.

Typing modified (coercion into a private type):
Example:
    module Blob: { type t = private {size: float} } = { type t = {size: float} }
    type plain = {size: float}
    let fake = (p: plain) => (p :> Blob.t)
Before (rule): a record coerces into a record with compatible fields,
    private or not
After (rule): a record or variant coerces into a private record or variant
    only from that same type

Diagnostic added (coercion into a private type):
Example:
    let fake = (p: plain) => (p :> Blob.t)
Before (diagnostic): none
After (diagnostic):
    Type plain is not a subtype of Blob.t
    Blob.t is private: its values can only be built in the module that
    defines it, so another type cannot be coerced to it.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01CMkrYaktctdKc4M41WF36t
Claude-Session: https://claude.ai/code/session_01Kr4cjoUi2f5VpMvE6wT9bo
Signed-off-by: Christoph Knittel <ck@cca.io>

Author: cknitt

changes/coercion-into-private-type.breaking.md

@@ -0,0 +1 @@
+- Coercing another type into a private record or variant is an error: only the module defining a private type can build its values. Coercing out of a private type still works.

compiler/ml/ctype.ml

@@ -87,6 +87,7 @@ type subtype_context =
       right_record_name: Path.t;
       issues: Record_coercion.record_field_subtype_violation list;
     }
+  | Coercion_into_private_type of {typename: Path.t}
 
 exception Subtype of type_pairs * type_pairs * subtype_context option
 
@@ -3500,6 +3501,20 @@ let extract_concrete_typedecl_opt env t =
   | v -> Some v
   | exception Not_found -> None
 
+(* Whether [t2] is a private record or variant that [t1], another type, would
+   be coerced into *)
+let coerces_into_private_type env t1 t2 =
+  match extract_concrete_typedecl_opt env t2 with
+  | Some
+      ( p2,
+        _,
+        {type_private = Private; type_kind = Type_record _ | Type_variant _} )
+    -> (
+    match extract_concrete_typedecl_opt env t1 with
+    | Some (p1, _, _) -> not (Path.same p1 p2)
+    | None -> true)
+  | Some _ | None -> false
+
 let rec subtype_rec env trace t1 t2 cstrs =
   let t1 = repr t1 in
   let t2 = repr t2 in
@@ -3564,6 +3579,20 @@ let rec subtype_rec env trace t1 t2 cstrs =
           (trace, t1, t2, !(current_univar_pairs ()), None) :: cstrs)
       | Tconstr (p1, _, _), _ when generic_private_abbrev env p1 ->
         subtype_rec env trace (expand_abbrev_opt env t1) t2 cstrs
+      | _, Tconstr _ when coerces_into_private_type env t1 t2 ->
+        (* Only the module defining a private record or variant builds its
+           values; a coercion from another type would build one anywhere *)
+        let typename =
+          match extract_concrete_typedecl_opt env t2 with
+          | Some (p2, _, _) -> p2
+          | None -> assert false
+        in
+        ( trace,
+          t1,
+          t2,
+          !(current_univar_pairs ()),
+          Some (Coercion_into_private_type {typename}) )
+        :: cstrs
       | Tconstr (p1, [], _), Tconstr (p2, [], _)
         when Path.same p1 Predef.path_int && Path.same p2 Predef.path_float ->
         (* Int can always be coerced to float *)

compiler/ml/ctype.mli

@@ -51,6 +51,9 @@ type subtype_context =
       right_record_name: Path.t;
       issues: Record_coercion.record_field_subtype_violation list;
     }  (** Records have fields that are not compatible. *)
+  | Coercion_into_private_type of {typename: Path.t}
+      (** The target is a private record or variant, whose values only its own
+          module can build. *)
 
 type type_pairs = (type_expr * type_expr) list
 exception Unify of type_pairs

compiler/ml/printtyp.ml

@@ -1789,7 +1789,12 @@ let report_subtyping_error ppf env tr1 txt1 tr2 ctx =
               fprintf ppf "@ - ";
               print_record_field_subtype_violation ppf issue ~left_record_name
                 ~right_record_name)
-            issues)
+            issues
+        | Coercion_into_private_type {typename} ->
+          fprintf ppf
+            "@ @{<info>%s@} is private: its values can only be built in the \
+             module that defines it, so another type cannot be coerced to it."
+            (Path.name typename))
       | None -> ())
 
 let report_ambiguous_type_error ppf env (tp0, tp0') tpl txt1 txt2 txt3 =

tests/build_tests/super_errors/expected/coercion_into_private_record.res.expected

@@ -0,0 +1,14 @@
+
+  We've found a bug for you!
+  /.../fixtures/coercion_into_private_record.res:12:35-45
+
+  10 │ 
+  11 │ // A plain record coerced into a private one: constructs a Blob.t from 
+     │ outside
+  12 │ let fake = (p: plain): Blob.t => (p :> Blob.t)
+  13 │ let s = Blob.size(fake({size: 1.}))
+  14 │ 
+
+  Type plain is not a subtype of Blob.t 
+
+  Blob.t is private: its values can only be built in the module that defines it, so another type cannot be coerced to it.

tests/build_tests/super_errors/expected/coercion_into_private_record_from_private.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/coercion_into_private_record_from_private.res:16:15-37
+
+  14 │ }
+  15 │ 
+  16 │ let forged = (Fake.make(1.) :> Blob.t)
+  17 │ 
+
+  Type Fake.t is not a subtype of Blob.t 
+
+  Blob.t is private: its values can only be built in the module that defines it, so another type cannot be coerced to it.

tests/build_tests/super_errors/expected/coercion_into_private_unboxed_variant.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/coercion_into_private_unboxed_variant.res:6:19-29
+
+  4 │   @unboxed type t = Text(string) | Number(int)
+  5 │ }
+  6 │ let fromString = ("a" :> Id.t)
+  7 │ 
+
+  Type string is not a subtype of Id.t 
+
+  Id.t is private: its values can only be built in the module that defines it, so another type cannot be coerced to it.

tests/build_tests/super_errors/expected/coercion_into_private_variant.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/coercion_into_private_variant.res:8:16-37
+
+  6 │ 
+  7 │ type plain = Red | Green
+  8 │ let forged = ((Red: plain) :> Color.t)
+  9 │ 
+
+  Type plain is not a subtype of Color.t 
+
+  Color.t is private: its values can only be built in the module that defines it, so another type cannot be coerced to it.

tests/build_tests/super_errors/expected/coercion_into_private_variant_from_polyvariant.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/coercion_into_private_variant_from_polyvariant.res:6:18-41
+
+  4 │   type t = Red | Green
+  5 │ }
+  6 │ let fromPoly = ((#Red: [#Red]) :> Color.t)
+  7 │ 
+
+  Type [#Red] is not a subtype of Color.t 
+
+  Color.t is private: its values can only be built in the module that defines it, so another type cannot be coerced to it.

tests/build_tests/super_errors/fixtures/coercion_into_private_record.res

@@ -0,0 +1,13 @@
+module Blob: {
+  type t = private {size: float}
+  let size: t => float
+} = {
+  type t = {size: float}
+  let size = b => b.size
+}
+
+type plain = {size: float}
+
+// A plain record coerced into a private one: constructs a Blob.t from outside
+let fake = (p: plain): Blob.t => (p :> Blob.t)
+let s = Blob.size(fake({size: 1.}))