Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

fix #show regression in 4.14 #10839

Merged
merged 1 commit into from
Jan 27, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
3 changes: 3 additions & 0 deletions Changes
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
20 changes: 20 additions & 0 deletions testsuite/tests/tool-toplevel/show.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
22 changes: 18 additions & 4 deletions toplevel/topdirs.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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."

Expand Down