fix #show regression in 4.14

Changes

@@ -148,6 +148,9 @@ OCaml 4.14.0
 
 ### Tools:
 
+- #10839: Fix regression of #show when printing class type
+  (Élie Brami, review by Florian Angeletti)
+
 - #3959, #7202, #10476: ocaml, in script mode, directive errors
   (`#use "missing_file";;`) use stderr and exit with an error.
   (Florian Angeletti, review by Gabriel Scherer)

testsuite/tests/tool-toplevel/show.ml

@@ -5,6 +5,26 @@
 (* this is a set of tests to test the #show functionality
  * of toplevel *)
 
+class o = object val x = 0 end;;
+[%%expect{|
+class o : object val x : int end
+|}];;
+#show o;;
+[%%expect{|
+class o : object val x : int end
+class type o = object val x : int end
+type o = <  >
+|}];;
+class type t = object val x : int end;;
+[%%expect{|
+class type t = object val x : int end
+|}];;
+#show t;;
+[%%expect{|
+class type t = object val x : int end
+type t = <  >
+|}];;
+
 #show Foo;;
 [%%expect {|
 Unknown element.

toplevel/topdirs.ml

@@ -435,18 +435,6 @@ let is_nonrec_type id td =
   | true, _ | _, false -> Trec_first
     (* note: true, true is possible *)
 
-let () =
-  reg_show_prim "show_type"
-    (fun env loc id lid ->
-       let path, desc = Env.lookup_type ~loc lid env in
-       let id, rs = match path with
-         | Pident id -> id, is_nonrec_type id desc
-         | _ -> id, Trec_first
-       in
-       [ Sig_type (id, desc, rs, Exported) ]
-    )
-    "Print the signature of the corresponding type constructor."
-
 (* Each registered show_prim function is called in turn
  * and any output produced is sent to std_out.
  * Two show_prim functions are needed for constructors,
@@ -571,19 +559,45 @@ let () =
 let () =
   reg_show_prim "show_class"
     (fun env loc id lid ->
-       let _path, desc = Env.lookup_class ~loc lid env in
-       [ Sig_class (id, desc, Trec_not, Exported) ]
+       let path, desc_class = Env.lookup_class ~loc lid env in
+       let _path, desc_cltype = Env.lookup_cltype ~loc lid env in
+       let _path, typedcl = Env.lookup_type ~loc lid env in
+       let hash_typedcl = Env.find_hash_type path env in
+       [
+         Sig_class (id, desc_class, Trec_not, Exported);
+         Sig_class_type (id, desc_cltype, Trec_not, Exported);
+         Sig_type (id, typedcl, Trec_not, Exported);
+         Sig_type (id, hash_typedcl, Trec_not, Exported);
+       ]
     )
     "Print the signature of the corresponding class."
 
 let () =
   reg_show_prim "show_class_type"
     (fun env loc id lid ->
-       let _path, desc = Env.lookup_cltype ~loc lid env in
-       [ Sig_class_type (id, desc, Trec_not, Exported) ]
+       let path, desc = Env.lookup_cltype ~loc lid env in
+       let _path, typedcl = Env.lookup_type ~loc lid env in
+       let hash_typedcl = Env.find_hash_type path env in
+       [
+         Sig_class_type (id, desc, Trec_not, Exported);
+         Sig_type (id, typedcl, Trec_not, Exported);
+         Sig_type (id, hash_typedcl, Trec_not, Exported);
+       ]
     )
     "Print the signature of the corresponding class type."
 
+let () =
+  reg_show_prim "show_type"
+    (fun env loc id lid ->
+       let path, desc = Env.lookup_type ~loc lid env in
+       let id, rs = match path with
+         | Pident id -> id, is_nonrec_type id desc
+         | _ -> id, Trec_first
+       in
+       [ Sig_type (id, desc, rs, Exported) ]
+    )
+    "Print the signature of the corresponding type constructor."
+
 let show env loc id lid =
   let sg =
     List.fold_left