Skip to content

Commit 867f688

Browse files
jonludlamjonludlam
committed
Add a bunch of tests for testing module type of and include 
1 parent 19e2472 commit 867f688

File tree

15 files changed

+505
-114
lines changed

15 files changed

+505
-114
lines changed

‎test/odoc_print/odoc_print.ml‎

Lines changed: 93 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -163,8 +163,59 @@ let print_element elt =
163163
| Element.ClassType v -> print_json_desc Lang_desc.classtype_t v
164164
| Element.Class v -> print_json_desc Lang_desc.class_t v
165165

166-
let run inp ref =
166+
let print_short c elt =
167+
let open Odoc_xref2 in
168+
let open Component.Fmt in
169+
match elt with
170+
| Element.Module m ->
171+
let m' = Component.Of_Lang.(module_ (empty ()) m) in
172+
Format.fprintf Format.std_formatter "@[<v 2>module %a %a@]"
173+
(model_identifier c)
174+
(m.id :> Odoc_model.Paths.Identifier.t)
175+
(module_ c) m'
176+
| Element.ModuleType m ->
177+
let m' = Component.Of_Lang.(module_type (empty ()) m) in
178+
Format.fprintf Format.std_formatter "@[<v 2>module type %a %a@]"
179+
(model_identifier c)
180+
(m.id :> Odoc_model.Paths.Identifier.t)
181+
(module_type c) m'
182+
| Element.Type t ->
183+
let t' = Component.Of_Lang.(type_decl (empty ()) t) in
184+
Format.fprintf Format.std_formatter "@[<v 2>type %a %a@]"
185+
(model_identifier c)
186+
(t.id :> Odoc_model.Paths.Identifier.t)
187+
(type_decl c) t'
188+
| Element.Value v ->
189+
let v' = Component.Of_Lang.(value (empty ()) v) in
190+
Format.fprintf Format.std_formatter "@[<v 2>val %a %a@]"
191+
(model_identifier c)
192+
(v.id :> Odoc_model.Paths.Identifier.t)
193+
(value c) v'
194+
| Element.ClassType ct ->
195+
let ct' = Component.Of_Lang.(class_type (empty ()) ct) in
196+
Format.fprintf Format.std_formatter "@[<v 2>val %a %a@]"
197+
(model_identifier c)
198+
(ct.id :> Odoc_model.Paths.Identifier.t)
199+
(class_type c) ct'
200+
| Element.Class cls ->
201+
let cls' = Component.Of_Lang.(class_ (empty ()) cls) in
202+
Format.fprintf Format.std_formatter "@[<v 2>val %a %a@]"
203+
(model_identifier c)
204+
(cls.id :> Odoc_model.Paths.Identifier.t)
205+
(class_ c) cls'
206+
207+
let run inp short long_paths show_canonical show_expansions
208+
show_include_expansions show_removed ref =
167209
let inp = Fpath.v inp in
210+
let c =
211+
{
212+
Odoc_xref2.Component.Fmt.short_paths = not long_paths;
213+
show_canonical;
214+
show_expansions;
215+
show_include_expansions;
216+
show_removed;
217+
}
218+
in
168219
Odoc_file.load inp >>= fun unit ->
169220
match unit.content with
170221
| Odoc_file.Source_tree_content tree ->
@@ -177,25 +228,26 @@ let run inp ref =
177228
print_json_desc Lang_desc.implementation_t impl;
178229
Ok ()
179230
| Unit_content u -> (
180-
match ref with
181-
| None ->
182-
print_json_desc Lang_desc.compilation_unit_t u;
231+
match (short, ref, u.content) with
232+
| true, None, Module sg ->
233+
let sg' = Odoc_xref2.Component.Of_Lang.(signature (empty ()) sg) in
234+
Format.printf "%a\n%!" Odoc_xref2.Component.Fmt.(signature c) sg';
183235
Ok ()
184-
| Some r -> (
236+
| _, Some r, Module sg -> (
185237
let r = Odoc_model.Semantics.parse_reference r in
186-
let sg =
187-
match u.content with
188-
| Module m -> m
189-
| Pack _ -> failwith "Can't look up in packed modules"
190-
in
191238
match Odoc_model.Error.raise_warnings r with
192239
| Ok r -> (
193240
match handle_ref sg r with
194241
| Some elt ->
195-
print_element elt;
242+
if short then print_short c elt else print_element elt;
196243
Ok ()
197244
| None -> Ok ())
198-
| _ -> Ok ()))
245+
| _ -> Ok ())
246+
| true, None, _ -> Error (`Msg "Can't short-print packed modules")
247+
| _, Some _, _ -> Error (`Msg "Can't look up in packed modules")
248+
| false, None, _ ->
249+
print_json_desc Lang_desc.compilation_unit_t u;
250+
Ok ())
199251

200252
open Compatcmdliner
201253

@@ -207,9 +259,37 @@ let a_inp =
207259
let doc = "Input file." in
208260
Arg.(required & pos 0 (some file) None & info ~doc ~docv:"PATH" [])
209261

262+
let a_short =
263+
let doc = "Short output." in
264+
Arg.(value & flag & info ~doc [ "short" ])
265+
266+
let a_show_expansions =
267+
let doc = "Show expansions in short output" in
268+
Arg.(value & flag & info ~doc [ "show-expansions" ])
269+
270+
let a_long_paths =
271+
let doc = "Show long paths in short output" in
272+
Arg.(value & flag & info ~doc [ "long-paths" ])
273+
274+
let a_show_canonical =
275+
let doc = "Show modules canonical reference in short output" in
276+
Arg.(value & flag & info ~doc [ "show-canonical" ])
277+
278+
let a_show_include_expansions =
279+
let doc = "Show include expansions in short output" in
280+
Arg.(value & flag & info ~doc [ "show-include-expansions" ])
281+
282+
let a_show_removed =
283+
let doc = "Show removed items in signature expansions in short output." in
284+
Arg.(value & flag & info ~doc [ "show-removed" ])
285+
210286
let term =
211287
let doc = "Print the content of .odoc files into a text format. For tests" in
212-
Term.(const run $ a_inp $ reference, info "odoc_print" ~doc)
288+
Term.
289+
( const run $ a_inp $ a_short $ a_long_paths $ a_show_canonical
290+
$ a_show_expansions $ a_show_include_expansions $ a_show_removed
291+
$ reference,
292+
info "odoc_print" ~doc )
213293

214294
let () =
215295
match Term.eval term with

‎test/xref2/hidden_modules.t/run.t‎

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,32 @@ aren't roots.
3131

3232
val test : 'a CanonicalTest.Base__.List.t -> unit
3333
34+
35+
module Enclosing : sig
36+
(** This is going to contain a hidden item *)
37+
38+
(**/**)
39+
module Hidden : sig
40+
module Still_hidden : sig
41+
type t
42+
end
43+
end
44+
45+
(**/**)
46+
47+
end
48+
49+
50+
module NonCanonical : sig
51+
52+
module NotHidden = Enclosing.Hidden.Still_hidden
53+
(** This ought to be expanded *)
54+
55+
type hidden__type = int
56+
57+
val helpful : hidden__type
58+
end
59+
3460
3561
3662
$ ocamlc -c -bin-annot test.mli
@@ -40,10 +66,47 @@ This shouldn't cause any warnings:
4066

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

75+
There should be an expansion on `NotHidden`
76+
77+
$ odoc_print test.odocl -r NonCanonical.NotHidden | jq '.type_.Alias[1]'
78+
"None"
4779

80+
$ odoc_print test.odocl -r NonCanonical.helpful
81+
{
82+
"id": {
83+
"`Value": [
84+
{ "`Module": [ { "`Root": [ "None", "Test" ] }, "NonCanonical" ] },
85+
"helpful"
86+
]
87+
},
88+
"locs": "None",
89+
"doc": [],
90+
"type_": {
91+
"Constr": [
92+
{
93+
"`Resolved": {
94+
"`Identifier": {
95+
"`Type": [
96+
{
97+
"`Module": [
98+
{ "`Root": [ "None", "Test" ] }, "NonCanonical"
99+
]
100+
},
101+
"hidden__type"
102+
]
103+
}
104+
}
105+
},
106+
[]
107+
]
108+
},
109+
"value": "Abstract"
110+
}
48111

49112

‎test/xref2/hidden_modules.t/test.mli‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,3 +28,29 @@ end
2828

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

31+
32+
module Enclosing : sig
33+
(** This is going to contain a hidden item *)
34+
35+
(**/**)
36+
module Hidden : sig
37+
module Still_hidden : sig
38+
type t
39+
end
40+
end
41+
42+
(**/**)
43+
44+
end
45+
46+
47+
module NonCanonical : sig
48+
49+
module NotHidden = Enclosing.Hidden.Still_hidden
50+
(** This ought to be expanded *)
51+
52+
type hidden__type = int
53+
54+
val helpful : hidden__type
55+
end
56+

‎test/xref2/module_type_of.t/run.t‎

Lines changed: 17 additions & 101 deletions
Original file line numberDiff line numberDiff line change
@@ -38,113 +38,29 @@ Compile
3838
Tests
3939
-----
4040
41-
Make sure the expansion of `T` is present
42-
43-
Check that the expansion of `T` contains only 2 modules (the module `X` should have been removed)
44-
45-
$ odoc_print m.odocl | jq ".content.Module.items[2].ModuleType.expr.Some.With.w_expansion.Some.Signature.items" > T_sig.json
46-
$ jq "map(map_values(.id))" < T_sig.json
47-
[
48-
{
49-
"ModuleType": {
50-
"`ModuleType": [
51-
{
52-
"`ModuleType": [
53-
{
54-
"`Root": [
55-
{
56-
"Some": {
57-
"`Page": [
58-
"None",
59-
"test"
60-
]
61-
}
62-
},
63-
"M"
64-
]
65-
},
66-
"T"
67-
]
68-
},
69-
"Y"
70-
]
71-
}
72-
},
73-
{
74-
"ModuleType": {
75-
"`ModuleType": [
76-
{
77-
"`ModuleType": [
78-
{
79-
"`Root": [
80-
{
81-
"Some": {
82-
"`Page": [
83-
"None",
84-
"test"
85-
]
86-
}
87-
},
88-
"M"
89-
]
90-
},
91-
"T"
92-
]
93-
},
94-
"Z"
95-
]
96-
}
97-
}
98-
]
41+
Make sure the expansion of `T` is present, and check that the expansion of `T`
42+
contains only 2 modules (the module `X` should have been removed)
43+
44+
$ odoc_print m.odocl -r T --short --show-expansions
45+
module type M.T = M.S with X := M.X1
46+
(sig :
47+
module type Y = module type of M.X1 (sig : type t end)
48+
module type Z = module type of struct include M.X1 end
49+
(sig : type t = M.X1.t end)
50+
end)
9951
10052
Check that the expansion of 'T.Y' contains only 1 type
10153
102-
$ jq ".[0].ModuleType.expr.Some.TypeOf.t_expansion.Some.Signature.items" < T_sig.json > T.Y_sig.json
103-
$ odoc_print m.odocl | jq "map(keys | .[0])" < T.Y_sig.json
104-
[
105-
"Type"
106-
]
54+
$ odoc_print m.odocl -r T.Y --short --show-expansions
55+
module type M.T.Y = module type of M.X1
56+
(sig : type t end)
10757
10858
Verify that T.Y.t has not been strengthened
10959
110-
$ jq ".[0].Type[1].equation.manifest" < T.Y_sig.json
111-
"None"
60+
$ odoc_print m.odocl -r T.Y.t --short
61+
type M.T.Y.t
11262
11363
But that T.Z.t _has_ been strengthened
11464
115-
$ jq ".[1].ModuleType.expr.Some.TypeOf.t_expansion.Some.Signature.items" < T_sig.json > T.Z_sig.json
116-
$ jq ".[0].Type[1].equation.manifest" < T.Z_sig.json
117-
{
118-
"Some": {
119-
"Constr": [
120-
{
121-
"`Resolved": {
122-
"`Type": [
123-
{
124-
"`Identifier": {
125-
"`Module": [
126-
{
127-
"`Root": [
128-
{
129-
"Some": {
130-
"`Page": [
131-
"None",
132-
"test"
133-
]
134-
}
135-
},
136-
"M"
137-
]
138-
},
139-
"X1"
140-
]
141-
}
142-
},
143-
"t"
144-
]
145-
}
146-
},
147-
[]
148-
]
149-
}
150-
}
65+
$ odoc_print m.odocl -r T.Z.t --short
66+
type M.T.Z.t = M.X1.t

‎test/xref2/module_type_of_extra.t/a.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
module X : sig type t end

0 commit comments

Comments
 (0)