Apply short-paths to an additional case

testsuite/tests/typing-short-paths/errors.ml

@@ -15,7 +15,7 @@ Line 5, characters 14-15:
 5 | let x : M.t = S
                   ^
 Error: This variant expression is expected to have type t
-       The constructor S does not belong to type M.t
+       The constructor S does not belong to type t
 |}]
 
 module M = struct

typing/printtyp.ml

@@ -1119,6 +1119,12 @@ and type_sch ppf ty = typexp true ppf ty
 
 and type_scheme ppf ty = reset_and_mark_loops ty; typexp true ppf ty
 
+let type_path ppf p =
+  let (p', s) = best_type_path p in
+  let p = if (s = Id) then p' else p in
+  let t = tree_of_path Type p in
+  !Oprint.out_ident ppf t
+
 (* Maxence *)
 let type_scheme_max ?(b_reset_names=true) ppf ty =
   if b_reset_names then reset_names () ;

typing/printtyp.mli

@@ -25,6 +25,10 @@ val tree_of_path: Path.t -> out_ident
 val path: formatter -> Path.t -> unit
 val string_of_path: Path.t -> string
 
+val type_path: formatter -> Path.t -> unit
+(** Print a type path taking account of [-short-paths].
+    Calls should be within [wrap_printing_env]. *)
+
 module Out_name: sig
   val create: string -> out_name
   val print: out_name -> string
@@ -88,7 +92,6 @@ module Conflicts: sig
   val reset: unit -> unit
 end
 
-
 val reset: unit -> unit
 val mark_loops: type_expr -> unit
 val reset_and_mark_loops: type_expr -> unit

typing/typecore.ml

@@ -5190,7 +5190,7 @@ let report_error ~loc env = function
               "@[The field %s is not part of the record \
                argument for the %a constructor@]"
               name.txt
-              Printtyp.path type_path;
+              Printtyp.type_path type_path;
           end else begin
             fprintf ppf
               "@[@[<2>%s type@ %a%t@]@ \
@@ -5198,7 +5198,7 @@ let report_error ~loc env = function
               eorp Printtyp.type_expr ty
               (report_type_expected_explanation_opt explanation)
               (Datatype_kind.label_name kind)
-              name.txt (*kind*) Printtyp.path type_path;
+              name.txt (*kind*) Printtyp.type_path type_path;
           end;
           spellcheck ppf name.txt valid_names
       )) ()
@@ -5430,7 +5430,8 @@ let report_error ~loc env = function
           fprintf ppf "but bindings were expected of type")
 
 let report_error ~loc env err =
-  Printtyp.wrap_printing_env ~error:true env (fun () -> report_error ~loc env err)
+  Printtyp.wrap_printing_env ~error:true env
+    (fun () -> report_error ~loc env err)
 
 let () =
   Location.register_error_of_exn