Merge pull request #11609 from Octachron/pr11194_unbound_and_printing…

…_context

(cherry picked from commit 1b93239)

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)
 ----------------------------
 

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
+|}]

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
+|}]

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

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

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