Skip to content

Commit

Permalink
Add a bunch of tests for testing module type of and include
Browse files Browse the repository at this point in the history
  • Loading branch information
@jonludlam
jonludlam committed Feb 8, 2024
1 parent 7021f99 commit 294633f
Show file tree
Hide file tree
Showing 15 changed files with 505 additions and 114 deletions.
106 changes: 93 additions & 13 deletions test/odoc_print/odoc_print.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -163,8 +163,59 @@ let print_element elt =
| Element.ClassType v -> print_json_desc Lang_desc.classtype_t v
| Element.Class v -> print_json_desc Lang_desc.class_t v

let run inp ref =
let print_short c elt =
let open Odoc_xref2 in
let open Component.Fmt in
match elt with
| Element.Module m ->
let m' = Component.Of_Lang.(module_ (empty ()) m) in
Format.fprintf Format.std_formatter "@[<v 2>module %a %a@]"
(model_identifier c)
(m.id :> Odoc_model.Paths.Identifier.t)
(module_ c) m'
| Element.ModuleType m ->
let m' = Component.Of_Lang.(module_type (empty ()) m) in
Format.fprintf Format.std_formatter "@[<v 2>module type %a %a@]"
(model_identifier c)
(m.id :> Odoc_model.Paths.Identifier.t)
(module_type c) m'
| Element.Type t ->
let t' = Component.Of_Lang.(type_decl (empty ()) t) in
Format.fprintf Format.std_formatter "@[<v 2>type %a %a@]"
(model_identifier c)
(t.id :> Odoc_model.Paths.Identifier.t)
(type_decl c) t'
| Element.Value v ->
let v' = Component.Of_Lang.(value (empty ()) v) in
Format.fprintf Format.std_formatter "@[<v 2>val %a %a@]"
(model_identifier c)
(v.id :> Odoc_model.Paths.Identifier.t)
(value c) v'
| Element.ClassType ct ->
let ct' = Component.Of_Lang.(class_type (empty ()) ct) in
Format.fprintf Format.std_formatter "@[<v 2>val %a %a@]"
(model_identifier c)
(ct.id :> Odoc_model.Paths.Identifier.t)
(class_type c) ct'
| Element.Class cls ->
let cls' = Component.Of_Lang.(class_ (empty ()) cls) in
Format.fprintf Format.std_formatter "@[<v 2>val %a %a@]"
(model_identifier c)
(cls.id :> Odoc_model.Paths.Identifier.t)
(class_ c) cls'

let run inp short long_paths show_canonical show_expansions
show_include_expansions show_removed ref =
let inp = Fpath.v inp in
let c =
{
Odoc_xref2.Component.Fmt.short_paths = not long_paths;
show_canonical;
show_expansions;
show_include_expansions;
show_removed;
}
in
Odoc_file.load inp >>= fun unit ->
match unit.content with
| Odoc_file.Source_tree_content tree ->
Expand All @@ -174,25 +225,26 @@ let run inp ref =
print_json_desc Lang_desc.page_t page;
Ok ()
| Unit_content u -> (
match ref with
| None ->
print_json_desc Lang_desc.compilation_unit_t u;
match (short, ref, u.content) with
| true, None, Module sg ->
let sg' = Odoc_xref2.Component.Of_Lang.(signature (empty ()) sg) in
Format.printf "%a\n%!" Odoc_xref2.Component.Fmt.(signature c) sg';
Ok ()
| Some r -> (
| _, Some r, Module sg -> (
let r = Odoc_model.Semantics.parse_reference r in
let sg =
match u.content with
| Module m -> m
| Pack _ -> failwith "Can't look up in packed modules"
in
match Odoc_model.Error.raise_warnings r with
| Ok r -> (
match handle_ref sg r with
| Some elt ->
print_element elt;
if short then print_short c elt else print_element elt;
Ok ()
| None -> Ok ())
| _ -> Ok ()))
| _ -> Ok ())
| true, None, _ -> Error (`Msg "Can't short-print packed modules")
| _, Some _, _ -> Error (`Msg "Can't look up in packed modules")
| false, None, _ ->
print_json_desc Lang_desc.compilation_unit_t u;
Ok ())

open Compatcmdliner

Expand All @@ -204,9 +256,37 @@ let a_inp =
let doc = "Input file." in
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PATH" [])

let a_short =
let doc = "Short output." in
Arg.(value & flag & info ~doc [ "short" ])

let a_show_expansions =
let doc = "Show expansions in short output" in
Arg.(value & flag & info ~doc [ "show-expansions" ])

let a_long_paths =
let doc = "Show long paths in short output" in
Arg.(value & flag & info ~doc [ "long-paths" ])

let a_show_canonical =
let doc = "Show modules canonical reference in short output" in
Arg.(value & flag & info ~doc [ "show-canonical" ])

let a_show_include_expansions =
let doc = "Show include expansions in short output" in
Arg.(value & flag & info ~doc [ "show-include-expansions" ])

let a_show_removed =
let doc = "Show removed items in signature expansions in short output." in
Arg.(value & flag & info ~doc [ "show-removed" ])

let term =
let doc = "Print the content of .odoc files into a text format. For tests" in
Term.(const run $ a_inp $ reference, info "odoc_print" ~doc)
Term.
( const run $ a_inp $ a_short $ a_long_paths $ a_show_canonical
$ a_show_expansions $ a_show_include_expansions $ a_show_removed
$ reference,
info "odoc_print" ~doc )

let () =
match Term.eval term with
Expand Down
63 changes: 63 additions & 0 deletions test/xref2/hidden_modules.t/run.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,32 @@ aren't roots.

val test : 'a CanonicalTest.Base__.List.t -> unit
module Enclosing : sig
(** This is going to contain a hidden item *)
(**/**)
module Hidden : sig
module Still_hidden : sig
type t
end
end
(**/**)
end
module NonCanonical : sig
module NotHidden = Enclosing.Hidden.Still_hidden
(** This ought to be expanded *)
type hidden__type = int
val helpful : hidden__type
end
$ ocamlc -c -bin-annot test.mli
Expand All @@ -40,10 +66,47 @@ This shouldn't cause any warnings:

$ odoc link test.odoc -I .
File "test.odoc":
Warning: Failed to resolve module path identifier(root(Test).Enclosing,false).Hidden.Still_hidden Parent_module: Find failure
File "test.odoc":
Warning: Failed to lookup type identifier(root(Test).CanonicalTest,false).Base__.List.t Parent_module: Parent_module: Find failure
File "test.mli", line 25, characters 8-17:
Warning: Failed to resolve reference unresolvedroot(List).t Couldn't find "List"

There should be an expansion on `NotHidden`

$ odoc_print test.odocl -r NonCanonical.NotHidden | jq '.type_.Alias[1]'
"None"

$ odoc_print test.odocl -r NonCanonical.helpful
{
"id": {
"`Value": [
{ "`Module": [ { "`Root": [ "None", "Test" ] }, "NonCanonical" ] },
"helpful"
]
},
"locs": "None",
"doc": [],
"type_": {
"Constr": [
{
"`Resolved": {
"`Identifier": {
"`Type": [
{
"`Module": [
{ "`Root": [ "None", "Test" ] }, "NonCanonical"
]
},
"hidden__type"
]
}
}
},
[]
]
},
"value": "Abstract"
}


26 changes: 26 additions & 0 deletions test/xref2/hidden_modules.t/test.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,3 +28,29 @@ end

val test : 'a CanonicalTest.Base__.List.t -> unit


module Enclosing : sig
(** This is going to contain a hidden item *)

(**/**)
module Hidden : sig
module Still_hidden : sig
type t
end
end

(**/**)

end


module NonCanonical : sig

module NotHidden = Enclosing.Hidden.Still_hidden
(** This ought to be expanded *)

type hidden__type = int

val helpful : hidden__type
end

118 changes: 17 additions & 101 deletions test/xref2/module_type_of.t/run.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -38,113 +38,29 @@ Compile
Tests
-----
Make sure the expansion of `T` is present
Check that the expansion of `T` contains only 2 modules (the module `X` should have been removed)
$ odoc_print m.odocl | jq ".content.Module.items[2].ModuleType.expr.Some.With.w_expansion.Some.Signature.items" > T_sig.json
$ jq "map(map_values(.id))" < T_sig.json
[
{
"ModuleType": {
"`ModuleType": [
{
"`ModuleType": [
{
"`Root": [
{
"Some": {
"`Page": [
"None",
"test"
]
}
},
"M"
]
},
"T"
]
},
"Y"
]
}
},
{
"ModuleType": {
"`ModuleType": [
{
"`ModuleType": [
{
"`Root": [
{
"Some": {
"`Page": [
"None",
"test"
]
}
},
"M"
]
},
"T"
]
},
"Z"
]
}
}
]
Make sure the expansion of `T` is present, and check that the expansion of `T`
contains only 2 modules (the module `X` should have been removed)
$ odoc_print m.odocl -r T --short --show-expansions
module type M.T = M.S with X := M.X1
(sig :
module type Y = module type of M.X1 (sig : type t end)
module type Z = module type of struct include M.X1 end
(sig : type t = M.X1.t end)
end)
Check that the expansion of 'T.Y' contains only 1 type
$ jq ".[0].ModuleType.expr.Some.TypeOf.t_expansion.Some.Signature.items" < T_sig.json > T.Y_sig.json
$ odoc_print m.odocl | jq "map(keys | .[0])" < T.Y_sig.json
[
"Type"
]
$ odoc_print m.odocl -r T.Y --short --show-expansions
module type M.T.Y = module type of M.X1
(sig : type t end)
Verify that T.Y.t has not been strengthened
$ jq ".[0].Type[1].equation.manifest" < T.Y_sig.json
"None"
$ odoc_print m.odocl -r T.Y.t --short
type M.T.Y.t
But that T.Z.t _has_ been strengthened
$ jq ".[1].ModuleType.expr.Some.TypeOf.t_expansion.Some.Signature.items" < T_sig.json > T.Z_sig.json
$ jq ".[0].Type[1].equation.manifest" < T.Z_sig.json
{
"Some": {
"Constr": [
{
"`Resolved": {
"`Type": [
{
"`Identifier": {
"`Module": [
{
"`Root": [
{
"Some": {
"`Page": [
"None",
"test"
]
}
},
"M"
]
},
"X1"
]
}
},
"t"
]
}
},
[]
]
}
}
$ odoc_print m.odocl -r T.Z.t --short
type M.T.Z.t = M.X1.t
1 change: 1 addition & 0 deletions test/xref2/module_type_of_extra.t/a.mli
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1 @@
module X : sig type t end
Loading

0 comments on commit 294633f

Please sign in to comment.