Merge pull request #10839 from Et7f3/fix_show_regression

fix #show regression in 4.14

Changes

@@ -156,6 +156,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{|
+type o = <  >
+class o : object val x : int end
+class type o = object val x : int end
+|}];;
+class type t = object val x : int end;;
+[%%expect{|
+class type t = object val x : int end
+|}];;
+#show t;;
+[%%expect{|
+type t = <  >
+class type t = object val x : int end
+|}];;
+
 #show Foo;;
 [%%expect {|
 Unknown element.

toplevel/topdirs.ml

@@ -571,16 +571,30 @@ 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."