From ca487304c540b9d24e05d732a971cd245b0ce999 Mon Sep 17 00:00:00 2001
From: Florian Angeletti <florian.angeletti@inria.fr>
Date: Mon, 17 Oct 2022 10:45:49 +0200
Subject: [PATCH] Merge pull request #11609 from
 Octachron/pr11194_unbound_and_printing_context

(cherry picked from commit 1b932390bc4ee798ec0e673199ebe2224494777a)
---
 Changes                                       |  5 +++++
 testsuite/tests/typing-objects/Tests.ml       | 13 +++++++++++++
 .../tests/typing-objects/unbound-type-var.ml  | 19 +++++++++++++++++++
 typing/printtyp.ml                            |  5 ++++-
 typing/printtyp.mli                           |  6 ++++++
 typing/typeclass.ml                           |  4 ++--
 6 files changed, 49 insertions(+), 3 deletions(-)
 create mode 100644 testsuite/tests/typing-objects/unbound-type-var.ml

diff --git a/Changes b/Changes
index aa8880ad07e3..9c5a5a959c5e 100644
--- a/Changes
+++ b/Changes
@@ -50,6 +50,11 @@ OCaml 4.14 maintenance branch
 - #11516, #11524: Fix the `deprecated_mutable` attribute.
   (Chris Casinghino, review by Nicolás Ojeda Bär and Florian Angeletti)
 
+- #11194, #11609: Fix inconsistent type variable names in "unbound type var"
+  messages
+  (Ulysse Gérard and Florian Angeletti, review Florian Angeletti and
+   Gabriel Scherer)
+
 OCaml 4.14.0 (28 March 2022)
 ----------------------------
 
diff --git a/testsuite/tests/typing-objects/Tests.ml b/testsuite/tests/typing-objects/Tests.ml
index 9cab28e43251..dd94c074e304 100644
--- a/testsuite/tests/typing-objects/Tests.ml
+++ b/testsuite/tests/typing-objects/Tests.ml
@@ -1405,3 +1405,16 @@ class virtual c = cv
 [%%expect {|
 class virtual c : cv
 |}];;
+
+(** Test classes abbreviations with a recursive type *)
+class ['a] c = object method m: (<x:'a; f:'b> as 'b) -> unit = fun _ -> () end
+class d = ['a] c
+[%%expect {|
+class ['a] c : object method m : (< f : 'b; x : 'a > as 'b) -> unit end
+Line 2, characters 0-16:
+2 | class d = ['a] c
+    ^^^^^^^^^^^^^^^^
+Error: Some type variables are unbound in this type: class d : ['a] c
+       The method m has type (< f : 'b; x : 'a > as 'b) -> unit where 'a
+       is unbound
+|}]
diff --git a/testsuite/tests/typing-objects/unbound-type-var.ml b/testsuite/tests/typing-objects/unbound-type-var.ml
new file mode 100644
index 000000000000..9e00cea20215
--- /dev/null
+++ b/testsuite/tests/typing-objects/unbound-type-var.ml
@@ -0,0 +1,19 @@
+(* TEST
+   * expect
+*)
+
+class test a c =
+object
+  method b = c
+end
+
+[%%expect{|
+Lines 1-4, characters 0-3:
+1 | class test a c =
+2 | object
+3 |   method b = c
+4 | end
+Error: Some type variables are unbound in this type:
+         class test : 'a -> 'b -> object method b : 'b end
+       The method b has type 'b where 'b is unbound
+|}]
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index 1a69644988e7..055ed707d938 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -1058,7 +1058,10 @@ let reset () =
   reset_except_context ()
 
 let prepare_for_printing tyl =
-  reset_except_context (); List.iter prepare_type tyl
+  reset_except_context ();
+  List.iter prepare_type tyl
+
+let add_type_to_preparation = prepare_type
 
 (* Disabled in classic mode when printing an unification error *)
 let print_labels = ref true
diff --git a/typing/printtyp.mli b/typing/printtyp.mli
index 13b2ed95e872..09571f4046ce 100644
--- a/typing/printtyp.mli
+++ b/typing/printtyp.mli
@@ -107,6 +107,12 @@ val type_expr: formatter -> type_expr -> unit
     Any type variables that are shared between multiple types in the input list
     will be given the same name when printed with [prepared_type_expr]. *)
 val prepare_for_printing: type_expr list -> unit
+
+(** [add_type_to_preparation ty] extend a previous type expression preparation
+    to the type expression [ty]
+*)
+val add_type_to_preparation: type_expr -> unit
+
 val prepared_type_expr: formatter -> type_expr -> unit
 (** The function [prepared_type_expr] is a less-safe but more-flexible version
     of [type_expr] that should only be called on [type_expr]s that have been
diff --git a/typing/typeclass.ml b/typing/typeclass.ml
index 8fa8523cc9ff..79d464fa7dfe 100644
--- a/typing/typeclass.ml
+++ b/typing/typeclass.ml
@@ -1973,7 +1973,6 @@ let report_error env ppf = function
         (function ppf ->
            fprintf ppf "but is expected to have type")
   | Unexpected_field (ty, lab) ->
-      Printtyp.prepare_for_printing [ty];
       fprintf ppf
         "@[@[<2>This object is expected to have type :@ %a@]\
          @ This type does not have a method %s."
@@ -2062,7 +2061,8 @@ let report_error env ppf = function
       let print_reason ppf (ty0, real, lab, ty) =
         let ty1 =
           if real then ty0 else Btype.newgenty(Tobject(ty0, ref None)) in
-        Printtyp.prepare_for_printing [ty; ty1];
+        Printtyp.add_type_to_preparation ty;
+        Printtyp.add_type_to_preparation ty1;
         fprintf ppf
           "The method %s@ has type@;<1 2>%a@ where@ %a@ is unbound"
           lab