this repo has no description
Merge commit 'ed811a3e93ac9eed370e648e595db9f7d4cdc343'
+522
-65
+10
-3
CHANGES.md
+10
-3
CHANGES.md
···
1
+
# Unreleased
2
+
3
+
### Added
4
+
- Allow persistent latex macros in HTML/KaTeX backend (@dlesbre, #1391)
5
+
- `markdown-generate` command now accepts multiple `.odocl` files in a single
6
+
invocation, eliminating the need for shell scripting (@davesnx, #1387)
7
+
8
+
### Fixed
9
+
- Fix compile-time crashing bugs #930 and #1385 (@jonludlam, #1400)
10
+
1
11
# 3.1.0
2
12
3
13
### Added
···
6
16
- New arguments to LaTeX generator, --shorten-beyond-depth and
7
17
--remove-functor-arg-link (@Octachron, #1337)
8
18
- New experimental markdown generator (@davesnx, #1341)
9
-
- `markdown-generate` command now accepts multiple `.odocl` files in a single
10
-
invocation, eliminating the need for shell scripting (@davesnx)
11
-
- Allow persistent latex macros in HTML/KaTeX backend (@dlesbre, #1391)
12
19
13
20
### Changed
14
21
- Remove cmdliner compatibility layer, no longer needed (@dbuenzli, #1328)
+7
-1
src/loader/cmti.ml
+7
-1
src/loader/cmti.ml
···
897
897
let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
898
898
let doc, status = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_status container incl.incl_attributes in
899
899
let content, shadowed = Cmi.read_signature_noenv env parent (Odoc_model.Compat.signature incl.incl_type) in
900
-
let expr = read_module_type env parent container incl.incl_mod in
900
+
(* Use a synthetic parent for the include's module type expression to avoid
901
+
identifier conflicts with items in the enclosing signature. Items inside
902
+
the include expression (like TypeSubstitutions) will get identifiers under
903
+
this synthetic parent, which won't clash with the real parent's items. *)
904
+
let include_parent = Identifier.fresh_include_parent parent in
905
+
let include_container = (include_parent :> Identifier.LabelParent.t) in
906
+
let expr = read_module_type env include_parent include_container incl.incl_mod in
901
907
let umty = Odoc_model.Lang.umty_of_mty expr in
902
908
let expansion = { content; shadowed; } in
903
909
#if defined OXCAML
+13
src/model/paths.ml
+13
src/model/paths.ml
···
644
644
`SourceLocationInternal (p, n))
645
645
end
646
646
647
+
(* Counter for generating unique synthetic parents for include expressions.
648
+
Items inside an include's module type expression need a different parent
649
+
to avoid identifier conflicts with items in the enclosing signature. *)
650
+
let include_parent_counter = ref 0
651
+
652
+
(* Create a synthetic parent identifier for items inside an include's module
653
+
type expression. Uses a lowercase module name (illegal in normal OCaml)
654
+
to ensure no clashes with real identifiers. *)
655
+
let fresh_include_parent (parent : Signature.t) : Signature.t =
656
+
incr include_parent_counter;
657
+
let name = Printf.sprintf "include%d_" !include_parent_counter in
658
+
(Mk.module_ (parent, ModuleName.make_std name) :> Signature.t)
659
+
647
660
module Hashtbl = struct
648
661
module Any = Hashtbl.Make (Any)
649
662
module ContainerPage = Hashtbl.Make (ContainerPage)
+6
src/model/paths.mli
+6
src/model/paths.mli
···
358
358
SourcePage.t * LocalName.t ->
359
359
[> `SourceLocationInternal of SourcePage.t * LocalName.t ] id
360
360
end
361
+
362
+
(** Create a synthetic parent identifier for items inside an include's
363
+
module type expression. Uses a lowercase module name (illegal in normal
364
+
OCaml) to ensure no clashes with real identifiers. Each call returns a
365
+
fresh identifier. *)
366
+
val fresh_include_parent : Signature.t -> Signature.t
361
367
end
362
368
363
369
(** Normal OCaml paths (i.e. the ones present in types) *)
+17
-5
src/xref2/compile.ml
+17
-5
src/xref2/compile.ml
···
322
322
let m' = module_type env mt in
323
323
let ty = Component.Of_Lang.(module_type (empty ()) m') in
324
324
let env' = Env.add_module_type mt.id ty env in
325
-
loop (ModuleType (module_type env mt) :: items) env' rest
325
+
let items' = ModuleType m' :: items in
326
+
loop items' env' rest
326
327
| ModuleTypeSubstitution mt ->
327
328
let env' = Env.open_module_type_substitution mt env in
328
329
loop
···
385
386
fun env id decl ->
386
387
let open Include in
387
388
match decl with
388
-
| ModuleType expr -> ModuleType (u_module_type_expr env id expr)
389
+
| ModuleType expr ->
390
+
let rec is_elidable_with_u : Odoc_model.Lang.ModuleType.U.expr -> bool =
391
+
function
392
+
| Path _ -> false
393
+
| Signature _ -> true
394
+
| With (_, expr) -> is_elidable_with_u expr
395
+
| TypeOf _ -> false
396
+
in
397
+
if is_elidable_with_u expr then ModuleType expr
398
+
else ModuleType (u_module_type_expr env id expr)
389
399
| Alias p -> Alias (module_path env p)
390
400
391
401
and module_type : Env.t -> ModuleType.t -> ModuleType.t =
···
424
434
Strengthen.signature cp sg
425
435
| None -> sg
426
436
in
427
-
let e = Lang_of.(simple_expansion map i.parent (Signature sg')) in
428
-
437
+
let sg'' = Tools.apply_inner_substs env sg' in
438
+
let e = Lang_of.(simple_expansion map i.parent (Signature sg'')) in
429
439
let expansion_sg =
430
440
match e with
431
441
| ModuleType.Signature sg -> sg
···
434
444
in
435
445
{ i.expansion with content = expansion_sg }
436
446
in
437
-
let expansion = get_expansion () in
447
+
let expansion =
448
+
if i.expansion.content.compiled then i.expansion else get_expansion ()
449
+
in
438
450
let items, env' = signature_items env i.parent expansion.content.items in
439
451
let expansion =
440
452
{
+10
-1
src/xref2/component.ml
+10
-1
src/xref2/component.ml
···
1093
1093
let pp_sep ppf () = Format.fprintf ppf ", " in
1094
1094
Format.fprintf ppf "(%a)" (Format.pp_print_list ~pp_sep type_param) ts
1095
1095
1096
-
and type_equation c ppf t =
1096
+
and type_equation_manifest c ppf t =
1097
1097
match t.TypeDecl.Equation.manifest with
1098
1098
| None -> ()
1099
1099
| Some m -> Format.fprintf ppf " = %a" (type_expr c) m
1100
+
1101
+
and type_equation_params _c ppf t =
1102
+
match t.TypeDecl.Equation.params with
1103
+
| [] -> ()
1104
+
| ps -> Format.fprintf ppf "%a" type_params ps
1105
+
1106
+
and type_equation c ppf t =
1107
+
Format.fprintf ppf "(params %a)%a" (type_equation_params c) t
1108
+
(type_equation_manifest c) t
1100
1109
1101
1110
and exception_ _c _ppf _e = ()
1102
1111
+4
-3
src/xref2/expand_tools.ml
+4
-3
src/xref2/expand_tools.ml
···
50
50
match t with
51
51
| Var (v, _) -> (
52
52
try List.assoc v map
53
-
with _ ->
54
-
Format.eprintf "Failed to list assoc %s\n%!" v;
55
-
failwith "bah")
53
+
with Not_found ->
54
+
Format.eprintf "Type variable '%s' not found in map [%s]@." v
55
+
(String.concat ", " (List.map fst map));
56
+
assert false)
56
57
| Any -> Any
57
58
| Alias (t, s) ->
58
59
if List.mem_assoc s map then raise Clash else Alias (type_expr map t, s)
+3
-1
src/xref2/lang_of.ml
+3
-1
src/xref2/lang_of.ml
···
651
651
(* Don't start shadowing within any signatures *)
652
652
match d with
653
653
| Alias p -> Alias (Path.module_ map p)
654
-
| ModuleType mty -> ModuleType (u_module_type_expr map identifier mty)
654
+
| ModuleType mty ->
655
+
let include_parent = Identifier.fresh_include_parent identifier in
656
+
ModuleType (u_module_type_expr map include_parent mty)
655
657
656
658
and include_ parent map i =
657
659
let open Component.Include in
+9
-2
src/xref2/link.ml
+9
-2
src/xref2/link.ml
···
712
712
and include_decl : Env.t -> Id.Signature.t -> Include.decl -> Include.decl =
713
713
fun env id decl ->
714
714
let open Include in
715
+
let rec is_elidable_with_u : Odoc_model.Lang.ModuleType.U.expr -> bool =
716
+
function
717
+
| Path _ -> false
718
+
| Signature _ -> true
719
+
| With (_, expr) -> is_elidable_with_u expr
720
+
| TypeOf _ -> false
721
+
in
715
722
match decl with
723
+
| ModuleType expr when is_elidable_with_u expr -> ModuleType expr
716
724
| ModuleType expr -> ModuleType (u_module_type_expr env id expr)
717
725
| Alias p -> Alias (module_path env p)
718
726
···
1187
1195
| e ->
1188
1196
Format.eprintf
1189
1197
"Caught unexpected exception when expanding type \
1190
-
declaration (%s)\n\
1191
-
%!"
1198
+
declaration (%s)@."
1192
1199
(Printexc.to_string e);
1193
1200
Constr (`Resolved p, ts))
1194
1201
| _ -> Constr (`Resolved p, ts)
+48
src/xref2/subst.ml
+48
src/xref2/subst.ml
···
29
29
unresolve_opaque_paths = false;
30
30
}
31
31
32
+
let pp fmt s =
33
+
let pp_map pp_binding b fmt map =
34
+
let pp_b fmt (id, v) =
35
+
Format.fprintf fmt "%a -> %a" Ident.fmt id pp_binding v
36
+
in
37
+
Format.fprintf fmt "@[<hov 1>{%a}@]" (Format.pp_print_list pp_b) (b map)
38
+
in
39
+
let pp_subst ppp fmt v =
40
+
Format.fprintf fmt "%s"
41
+
(match v with
42
+
| `Prefixed (p, _) -> Format.asprintf "%a" ppp p
43
+
| `Renamed id' -> Format.asprintf "%a" Ident.fmt id'
44
+
| `Substituted -> "<substituted>")
45
+
in
46
+
let pp_type_replacement fmt (te, eq) =
47
+
Format.fprintf fmt "(%a,%a)"
48
+
Component.Fmt.(type_expr default)
49
+
te
50
+
Component.Fmt.(type_equation default)
51
+
eq
52
+
in
53
+
54
+
Format.fprintf fmt
55
+
"{ module_ = %a;@ module_type = %a;@ type_ = %a;@ class_type = %a;@ \
56
+
type_replacement = %a;@ module_type_replacement = %a;@ \
57
+
path_invalidating_modules = [%a];@ unresolve_opaque_paths = %b }"
58
+
(pp_map (pp_subst Component.Fmt.(module_path default)) ModuleMap.bindings)
59
+
s.module_
60
+
(pp_map
61
+
(pp_subst Component.Fmt.(module_type_path default))
62
+
ModuleTypeMap.bindings)
63
+
s.module_type
64
+
(pp_map (pp_subst Component.Fmt.(type_path default)) TypeMap.bindings)
65
+
s.type_
66
+
(pp_map (pp_subst Component.Fmt.(class_type_path default)) TypeMap.bindings)
67
+
s.class_type
68
+
(pp_map pp_type_replacement TypeMap.bindings)
69
+
s.type_replacement
70
+
(pp_map Component.Fmt.(module_type_expr default) ModuleTypeMap.bindings)
71
+
s.module_type_replacement
72
+
(Format.pp_print_list Ident.fmt)
73
+
s.path_invalidating_modules s.unresolve_opaque_paths
74
+
32
75
let unresolve_opaque_paths s = { s with unresolve_opaque_paths = true }
33
76
34
77
let path_invalidate_module id t =
···
563
606
| Any -> acc
564
607
| Var (n, _) -> (n, type_expr s pexpr) :: acc
565
608
in
609
+
if List.length ts <> List.length eq.params then (
610
+
Format.eprintf
611
+
"Type substitution error: eq.params length=%d ts length=%d@."
612
+
(List.length eq.params) (List.length ts);
613
+
assert false);
566
614
let vars = List.fold_left2 mk_var [] ts eq.params in
567
615
substitute_vars vars t
568
616
| Not_replaced p -> Constr (p, List.map (type_expr s) ts))
+2
src/xref2/subst.mli
+2
src/xref2/subst.mli
+4
-4
src/xref2/test.md
+4
-4
src/xref2/test.md
···
975
975
val sg : Tools.expansion =
976
976
Odoc_xref2.Tools.Signature
977
977
{Odoc_xref2.Component.Signature.items =
978
-
[Odoc_xref2.Component.Signature.Module (`LModule (M, 32),
978
+
[Odoc_xref2.Component.Signature.Module (`LModule (M, 31),
979
979
Odoc_model.Lang.Signature.Ordinary,
980
980
{Odoc_xref2.Component.Delayed.v =
981
981
Some
···
1001
1001
None);
1002
1002
canonical = None; hidden = false};
1003
1003
get = None});
1004
-
Odoc_xref2.Component.Signature.Module (`LModule (N, 33),
1004
+
Odoc_xref2.Component.Signature.Module (`LModule (N, 32),
1005
1005
Odoc_model.Lang.Signature.Ordinary,
1006
1006
{Odoc_xref2.Component.Delayed.v =
1007
1007
Some
···
1014
1014
(Odoc_xref2.Component.ModuleType.Path
1015
1015
{Odoc_xref2.Component.ModuleType.p_expansion = None;
1016
1016
p_path =
1017
-
`DotMT (`Substituted (`Local (`LModule (M, 32), false)), S)});
1017
+
`DotMT (`Substituted (`Local (`LModule (M, 31), false)), S)});
1018
1018
canonical = None; hidden = false};
1019
1019
get = None})];
1020
1020
compiled = false; removed = [];
···
1064
1064
- : Tools.expansion =
1065
1065
Odoc_xref2.Tools.Signature
1066
1066
{Odoc_xref2.Component.Signature.items =
1067
-
[Odoc_xref2.Component.Signature.Type (`LType (t, 42),
1067
+
[Odoc_xref2.Component.Signature.Type (`LType (t, 41),
1068
1068
Odoc_model.Lang.Signature.Ordinary,
1069
1069
{Odoc_xref2.Component.Delayed.v =
1070
1070
Some
+65
src/xref2/tools.ml
+65
src/xref2/tools.ml
···
2350
2350
2351
2351
let resolve_class_type_path env p =
2352
2352
resolve_class_type env p >>= fun (p, _) -> Ok p
2353
+
2354
+
let apply_inner_substs env (sg : Component.Signature.t) : Component.Signature.t
2355
+
=
2356
+
let rec inner (items : Component.Signature.item list) :
2357
+
Component.Signature.item list =
2358
+
match items with
2359
+
| Component.Signature.TypeSubstitution (id, typedecl) :: rest -> (
2360
+
let subst =
2361
+
Component.ModuleType.TypeSubst
2362
+
(`Dot (`Root, Ident.Name.type_ id), typedecl.equation)
2363
+
in
2364
+
let rest =
2365
+
Component.Signature.Type
2366
+
(id, Ordinary, Component.Delayed.put (fun () -> typedecl))
2367
+
:: inner rest
2368
+
in
2369
+
match fragmap env subst { sg with items = rest } with
2370
+
| Ok sg' -> sg'.items
2371
+
| Error _ -> failwith "error")
2372
+
| Component.Signature.ModuleSubstitution (id, modsubst) :: rest -> (
2373
+
let subst =
2374
+
Component.ModuleType.ModuleSubst
2375
+
(`Dot (`Root, Ident.Name.module_ id), modsubst.manifest)
2376
+
in
2377
+
let rest =
2378
+
Component.Signature.Module
2379
+
( id,
2380
+
Ordinary,
2381
+
Component.Delayed.put (fun () ->
2382
+
{
2383
+
Component.Module.source_loc = None;
2384
+
doc = modsubst.doc;
2385
+
type_ = Alias (modsubst.manifest, None);
2386
+
canonical = None;
2387
+
hidden = false;
2388
+
}) )
2389
+
:: inner rest
2390
+
in
2391
+
match fragmap env subst { sg with items = rest } with
2392
+
| Ok sg' -> sg'.items
2393
+
| Error _ -> failwith "error")
2394
+
| Component.Signature.ModuleTypeSubstitution (id, modtypesubst) :: rest -> (
2395
+
let subst =
2396
+
Component.ModuleType.ModuleTypeSubst
2397
+
(`Dot (`Root, Ident.Name.module_type id), modtypesubst.manifest)
2398
+
in
2399
+
let rest =
2400
+
Component.Signature.ModuleType
2401
+
( id,
2402
+
Component.Delayed.put (fun () ->
2403
+
{
2404
+
Component.ModuleType.source_loc = None;
2405
+
doc = modtypesubst.doc;
2406
+
expr = Some modtypesubst.manifest;
2407
+
canonical = None;
2408
+
}) )
2409
+
:: inner rest
2410
+
in
2411
+
match fragmap env subst { sg with items = rest } with
2412
+
| Ok sg' -> sg'.items
2413
+
| Error _ -> failwith "error")
2414
+
| x :: rest -> x :: inner rest
2415
+
| [] -> []
2416
+
in
2417
+
{ sg with items = inner sg.items }
+2
src/xref2/tools.mli
+2
src/xref2/tools.mli
+2
-3
test/sources/functor.t/run.t
+2
-3
test/sources/functor.t/run.t
···
60
60
<a href="../../src/a.ml.html#module-F.val-y" class="source_link">Source
61
61
</a>
62
62
63
-
$ cat html/root/source/a.ml.html | grep L3
64
-
cat: html/root/source/a.ml.html: No such file or directory
65
-
[1]
63
+
$ cat html/src/a.ml.html | grep L3
64
+
<a id="L3" class="source_line" href="#L3">3</a>
66
65
67
66
However, on functor results, there is a link to source in the file:
68
67
+6
-3
test/xref2/expansion.t/run.t
+6
-3
test/xref2/expansion.t/run.t
···
20
20
module S :
21
21
sig
22
22
module type X = sig module M : sig type t end end
23
-
module X : X with M.t = int (sig : module M : sig type t = int end end)
23
+
module X : X with M.t(params ) = int
24
+
(sig : module M : sig type t = int end end)
24
25
module Y : sig type t end
25
26
module Z : module type of Y (sig : type t end)
26
27
module A : X (sig : module M : sig type t end end)
···
33
34
module S :
34
35
sig
35
36
module type X = sig module M : sig type t end end
36
-
module X : X with M.t = int (sig : module M : sig type t = int end end)
37
+
module X : X with M.t(params ) = int
38
+
(sig : module M : sig type t = int end end)
37
39
module Y : sig type t end
38
40
module Z : module type of Y (sig : type t end)
39
41
module A : X (sig : module M : sig type t end end)
···
42
44
module Test = S
43
45
(sig :
44
46
module type X = sig module M : sig type t end end
45
-
module X : X with M.t = int (sig : module M : sig type t = int end end)
47
+
module X : X with M.t(params ) = int
48
+
(sig : module M : sig type t = int end end)
46
49
module Y : sig type t end
47
50
module Z : module type of Y (sig : type t end)
48
51
module A : X (sig : module M : sig type t end end)
+61
test/xref2/github_issue_930.t/edge_cases.mli
+61
test/xref2/github_issue_930.t/edge_cases.mli
···
1
+
(** Edge case tests for GitHub issue #930 *)
2
+
3
+
(** Multiple TypeSubstitutions in same signature *)
4
+
module type Multi_subst = sig
5
+
type 'a t := unit
6
+
type 'b u := int
7
+
8
+
val f : bool t
9
+
val g : string u
10
+
end
11
+
12
+
(** Deeply nested includes - 5 levels deep *)
13
+
module type Level1 = sig
14
+
type 'a t := unit
15
+
val x : int t
16
+
end
17
+
18
+
module type Level2 = sig
19
+
type t
20
+
include Level1
21
+
end
22
+
23
+
module type Level3 = sig
24
+
include Level2
25
+
end
26
+
27
+
module type Level4 = sig
28
+
include Level3
29
+
end
30
+
31
+
module type Level5 = sig
32
+
include Level4
33
+
end
34
+
35
+
(** Multiple paths to same signature *)
36
+
module type Multipath_base = sig
37
+
type 'a t := unit
38
+
val x : int t
39
+
end
40
+
41
+
module type Multipath_via_a = sig
42
+
include Multipath_base
43
+
end
44
+
45
+
module type Multipath_via_b = sig
46
+
include Multipath_base
47
+
end
48
+
49
+
module type Multipath_use1 = sig
50
+
include Multipath_via_a
51
+
end
52
+
53
+
module type Multipath_use2 = sig
54
+
include Multipath_via_b
55
+
end
56
+
57
+
(** TypeSubstitution with record field types *)
58
+
module type With_record = sig
59
+
type 'a t := unit
60
+
type r = { field : int t }
61
+
end
+96
test/xref2/github_issue_930.t/run.t
+96
test/xref2/github_issue_930.t/run.t
···
1
+
Test for GitHub issue #930: Crash when substituting for the same name at different arities.
2
+
3
+
This tests that inline TypeSubstitution items (type 'a t := unit) are correctly
4
+
applied during include expansion, preventing crashes and producing correct output.
5
+
6
+
$ ocamlc -c -bin-annot test.mli
7
+
$ ocamlc -c -bin-annot edge_cases.mli
8
+
9
+
Compile and link both test files:
10
+
11
+
$ odoc compile test.cmti
12
+
$ odoc compile edge_cases.cmti
13
+
$ odoc link test.odoc
14
+
$ odoc link edge_cases.odoc
15
+
16
+
=== Test 1: Original MWE from issue #930 ===
17
+
18
+
The key test is that odoc doesn't crash with "Invalid_argument(List.fold_left2)".
19
+
Check that includes work correctly - the TypeSubstitution is applied when
20
+
S1 is included in S2 and S2 is included in S3:
21
+
22
+
$ odoc_print test.odocl -r S2.x | jq -c '.type_.Constr[0]'
23
+
{"`Resolved":{"`CoreType":"unit"}}
24
+
25
+
$ odoc_print test.odocl -r S3.x | jq -c '.type_.Constr[0]'
26
+
{"`Resolved":{"`CoreType":"unit"}}
27
+
28
+
=== Test 2: Issue #1385 - Creators_base with nested types ===
29
+
30
+
Check that S0_with_creators_base compiles without crashing and has the
31
+
concat function with simplified types (t -> t):
32
+
33
+
$ odoc_print test.odocl -r S0_with_creators_base.concat | jq -c '.type_.Arrow[1].Constr[0]'
34
+
{"`Resolved":{"`Identifier":{"`Type":[{"`ModuleType":[{"`Root":["None","Test"]},"S0_with_creators_base"]},"t"]}}}
35
+
36
+
$ odoc_print test.odocl -r S0_with_creators_base.concat | jq -c '.type_.Arrow[2].Constr[0]'
37
+
{"`Resolved":{"`Identifier":{"`Type":[{"`ModuleType":[{"`Root":["None","Test"]},"S0_with_creators_base"]},"t"]}}}
38
+
39
+
=== Test 3: Deeply nested includes ===
40
+
41
+
Level5 goes through 5 levels of includes with TypeSubstitution at Level1.
42
+
The substitution should be applied correctly through all levels:
43
+
44
+
$ odoc_print edge_cases.odocl -r Level5.x | jq -c '.type_.Constr[0]'
45
+
{"`Resolved":{"`CoreType":"unit"}}
46
+
47
+
=== Test 4: Multiple paths to same signature ===
48
+
49
+
Multipath_use1 and Multipath_use2 both include variations of Multipath_base:
50
+
51
+
$ odoc_print edge_cases.odocl -r Multipath_use1.x | jq -c '.type_.Constr[0]'
52
+
{"`Resolved":{"`CoreType":"unit"}}
53
+
54
+
$ odoc_print edge_cases.odocl -r Multipath_use2.x | jq -c '.type_.Constr[0]'
55
+
{"`Resolved":{"`CoreType":"unit"}}
56
+
57
+
=== Test 5: Verify HTML generation succeeds and shows correct types ===
58
+
59
+
$ odoc html-generate test.odocl -o html --indent
60
+
$ odoc html-generate edge_cases.odocl -o html --indent
61
+
62
+
S2.x should show "unit" (TypeSubstitution applied through include of S1):
63
+
64
+
$ grep "val.*x" html/Test/module-type-S2/index.html | sed 's/<[^>]*>//g' | grep -o "val x.*" | head -1
65
+
val x : unit
66
+
67
+
S3.x should show "unit" (TypeSubstitution applied through include of S2):
68
+
69
+
$ grep "val.*x" html/Test/module-type-S3/index.html | sed 's/<[^>]*>//g' | grep -o "val x.*" | head -1
70
+
val x : unit
71
+
72
+
Level5.x should show "unit" after 5 levels of nested includes:
73
+
74
+
$ grep "val.*x" html/Edge_cases/module-type-Level5/index.html | sed 's/<[^>]*>//g' | grep -o "val x.*" | head -1
75
+
val x : unit
76
+
77
+
=== Test 6: Verify TypeSubstitutions in includes are correctly applied ===
78
+
79
+
In S2 and S3, the TypeSubstitution from S1 should be applied (not shown as "type subst"):
80
+
81
+
$ grep -c "type subst" html/Test/module-type-S2/index.html 2>/dev/null || true
82
+
0
83
+
84
+
$ grep -c "type subst" html/Test/module-type-S3/index.html 2>/dev/null || true
85
+
0
86
+
87
+
Level5 should have no TypeSubstitution visible (applied through nested includes):
88
+
89
+
$ grep -c "type subst" html/Edge_cases/module-type-Level5/index.html 2>/dev/null || true
90
+
0
91
+
92
+
Note: S1 still shows its TypeSubstitution declaration because that's where it's defined.
93
+
This is expected - the substitution is only applied when the signature is included:
94
+
95
+
$ grep -c "type subst" html/Test/module-type-S1/index.html
96
+
1
+59
test/xref2/github_issue_930.t/test.mli
+59
test/xref2/github_issue_930.t/test.mli
···
1
+
(** Test for GitHub issue #930: Crash when substituting for the same name at
2
+
different arities.
3
+
4
+
The original issue was that odoc crashed with [Invalid_argument("List.fold_left2")]
5
+
when a signature had a destructive type substitution (type 'a t := unit) followed
6
+
by an include that re-introduces a type with the same name but different arity.
7
+
*)
8
+
9
+
(** Original MWE from issue #930 *)
10
+
module type S1 = sig
11
+
type t0
12
+
13
+
type 'a t := unit
14
+
(** Destructive substitution - 'a t becomes unit *)
15
+
16
+
val x : t0 t
17
+
end
18
+
19
+
module type S2 = sig
20
+
type t
21
+
(** This [t] has arity 0, different from S1's ['a t] *)
22
+
23
+
include S1 with type t0 := t
24
+
end
25
+
26
+
module type S3 = sig
27
+
type t1
28
+
29
+
include S2 with type t := t1
30
+
end
31
+
32
+
(** Updated MWE from issue #930 - simpler reproduction *)
33
+
module type Simple = sig
34
+
type 'a t := unit
35
+
36
+
include sig
37
+
type 'a t
38
+
39
+
val f : int t
40
+
end
41
+
with type 'a t := 'a t
42
+
end
43
+
44
+
(** Issue #1385 - related case with nested includes *)
45
+
module type Creators_base = sig
46
+
type ('a, 'b, 'c) t
47
+
type ('a, 'b, 'c) concat
48
+
49
+
include sig
50
+
type ('a, 'b, 'c) t
51
+
val concat : (('a, 'p1, 'p2) t, 'p1, 'p2) concat -> ('a, 'p1, 'p2) t
52
+
end
53
+
with type ('a, 'b, 'c) t := ('a, 'b, 'c) t
54
+
end
55
+
56
+
module type S0_with_creators_base = sig
57
+
type t
58
+
include Creators_base with type ('a, _, _) t := t and type ('a, _, _) concat := t
59
+
end
+52
test/xref2/include_self_reference.t/run.t
+52
test/xref2/include_self_reference.t/run.t
···
1
+
Test for include with type substitution referencing outer type.
2
+
3
+
When we have:
4
+
$ cat test.mli
5
+
(** Test case for include with type substitution referencing outer type.
6
+
7
+
When the include's signature has a TypeSubstitution like [type reader := reader],
8
+
the RHS [reader] refers to the outer type, not the substitution itself.
9
+
This should not create a self-referential TypeSubstitution. *)
10
+
11
+
module type Read = sig
12
+
type reader = unit
13
+
14
+
include sig
15
+
type reader := reader
16
+
17
+
val bin_read_unit : reader
18
+
end
19
+
end
20
+
21
+
The TypeSubstitution [type reader := reader] should substitute the inner
22
+
[reader] with the outer [reader] type. The RHS [reader] refers to the outer
23
+
type (type reader = unit), not the substitution itself.
24
+
25
+
Previously, items inside the include's signature expression were getting
26
+
identifiers with the same parent as siblings of the include statement.
27
+
This caused the TypeSubstitution's identifier to equal the outer type's
28
+
identifier, making the manifest appear as a self-reference.
29
+
30
+
$ ocamlc -c -bin-annot test.mli
31
+
32
+
Compile and link should succeed without errors:
33
+
34
+
$ odoc compile test.cmti
35
+
$ odoc link test.odoc
36
+
37
+
The resulting signature should have:
38
+
- type reader = unit
39
+
- val bin_read_unit : reader (where reader refers to the type above)
40
+
41
+
Check that bin_read_unit has type reader (resolved to the outer type):
42
+
43
+
$ odoc_print test.odocl -r Read.bin_read_unit | jq -c '.type_.Constr[0]'
44
+
{"`Resolved":{"`Identifier":{"`Type":[{"`ModuleType":[{"`Root":["None","Test"]},"Read"]},"reader"]}}}
45
+
46
+
Generate HTML and verify the output is correct:
47
+
48
+
$ odoc html-generate test.odocl -o html --indent
49
+
50
+
The module type Read should show both the type and the value:
51
+
52
+
$ grep -E "type reader|val bin_read_unit" html/Test/module-type-Read/index.html | sed 's/<[^>]*>//g' | sed 's/^[[:space:]]*//'
+15
test/xref2/include_self_reference.t/test.mli
+15
test/xref2/include_self_reference.t/test.mli
···
1
+
(** Test case for include with type substitution referencing outer type.
2
+
3
+
When the include's signature has a TypeSubstitution like [type reader := reader],
4
+
the RHS [reader] refers to the outer type, not the substitution itself.
5
+
This should not create a self-referential TypeSubstitution. *)
6
+
7
+
module type Read = sig
8
+
type reader = unit
9
+
10
+
include sig
11
+
type reader := reader
12
+
13
+
val bin_read_unit : reader
14
+
end
15
+
end
+15
-29
test/xref2/shadow3.t/run.t
+15
-29
test/xref2/shadow3.t/run.t
···
18
18
module type {B}1/shadowed/(CCCC) = A.B
19
19
include {B}1/shadowed/(CCCC)
20
20
(sig : module {A}1/shadowed/(AAAA) = A.A end)
21
-
module type B1 :=
22
-
sig
23
-
module A :
24
-
sig
25
-
include module type of struct include {A}1/shadowed/(AAAA) end
26
-
(sig :
27
-
include module type of struct include A.{A}1/shadowed/(AAAA) end
28
-
(sig : type t = {A}1/shadowed/(AAAA).t end)
29
-
type a = A.A.a
30
-
end)
31
-
type a
32
-
end
33
-
end
34
-
include B1 (sig : module {A}2/shadowed/(CCCC) = A.A end)
21
+
include sig
22
+
module A :
23
+
sig
24
+
include module type of struct include {A}1/shadowed/(AAAA) end
25
+
(sig : type t end)
26
+
type a
27
+
endend (sig : module {A}2/shadowed/(CCCC) = A.A end)
35
28
end)
36
29
include module type of struct include B end
37
30
(sig :
38
31
module type B = B.B
39
32
include B (sig : module {A}1/shadowed/(BBBB) = B.A end)
40
-
module type B1 :=
41
-
sig
42
-
module A :
43
-
sig
44
-
include module type of struct include {A}1/shadowed/(BBBB) end
45
-
(sig :
46
-
include module type of struct include B.{A}1/shadowed/(BBBB) end
47
-
(sig : type t = {A}1/shadowed/(BBBB).t end)
48
-
type b = B.A.b
49
-
end)
50
-
type b
51
-
end
52
-
end
53
-
include B1 (sig : module {A}3/shadowed/(CCCC) = B.A end)
33
+
include sig
34
+
module A :
35
+
sig
36
+
include module type of struct include {A}1/shadowed/(BBBB) end
37
+
(sig : type t end)
38
+
type b
39
+
endend (sig : module {A}3/shadowed/(CCCC) = B.A end)
54
40
end)
55
41
module A :
56
42
sig
57
43
include module type of struct include {A}3/shadowed/(CCCC) end
58
44
(sig :
59
45
include module type of struct include B.{A}1/shadowed/(BBBB) end
60
-
(sig : type t = {A}3/shadowed/(CCCC).t end)
46
+
(sig : type t = B.A.t end)
61
47
type b = B.A.b
62
48
end)
63
49
end
+11
-5
test/xref2/shadow5.t/run.t
+11
-5
test/xref2/shadow5.t/run.t
···
33
33
type t = int
34
34
val y : t
35
35
include sigtype t = t
36
-
val z : tend with [t = t] (sig : val z : t end)
36
+
val z : tend with [t(params ) = t] (sig : val z : t end)
37
37
end
38
38
module type Z =
39
39
sig
···
41
41
(sig :
42
42
type {t}1/shadowed/(AAAA) = int
43
43
val y : int
44
-
include sigtype t = t
45
-
val z : tend with [t = int] (sig : val z : int end)
44
+
include sig
45
+
type t = {t}1/shadowed/(AAAA)
46
+
val z : tend with [t(params ) = {t}1/shadowed/(AAAA)]
47
+
(sig : val z : int end)
46
48
end)
47
49
type t = int
48
50
end
···
76
78
$ odoc_print b.odocl --short --show-include-expansions
77
79
module type X = sig type t val z : t end
78
80
module type Y =
79
-
sig type t = int val y : t include X with [t = t] (sig : val z : t end) end
81
+
sig
82
+
type t = int
83
+
val y : t
84
+
include X with [t(params ) = t] (sig : val z : t end)
85
+
end
80
86
module type Z =
81
87
sig
82
88
include Y
83
89
(sig :
84
90
type {t}1/shadowed/(BBBB) = int
85
91
val y : int
86
-
include X with [t = int] (sig : val z : int end)
92
+
include X with [t(params ) = int] (sig : val z : int end)
87
93
end)
88
94
type t = int
89
95
end
+5
-5
test/xref2/subst/test.md
+5
-5
test/xref2/subst/test.md
···
131
131
module SomeMonad/20 :
132
132
sig
133
133
type t/25
134
-
include r(Monad/21) with [resolved(root(Monad/21).t) = [a] resolved(t/25)]
134
+
include r(Monad/21) with [resolved(root(Monad/21).t)(params (a)) = [a] resolved(t/25)]
135
135
(sig :
136
136
val map/26 : ([a] resolved(t/25)) -> ((a) -> b) -> [b] resolved(t/25)
137
137
val join/27 : ([[a] resolved(t/25)] resolved(t/25)) -> [a] resolved(t/25)
···
141
141
module ComplexTypeExpr/19 :
142
142
sig
143
143
type t/28
144
-
include r(Monad/21) with [resolved(root(Monad/21).t) = ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))]
144
+
include r(Monad/21) with [resolved(root(Monad/21).t)(params (a)) = ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))]
145
145
(sig :
146
146
val map/29 : (([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))) -> ((a) -> b) -> ([resolved(int) * b] resolved(t/28) * [b * resolved(int)] resolved(t/28))
147
147
val join/30 : (([resolved(int) * ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))] resolved(t/28) * [([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28)) * resolved(int)] resolved(t/28))) -> ([resolved(int) * a] resolved(t/28) * [a * resolved(int)] resolved(t/28))
···
150
150
end (canonical=None)
151
151
module Erase/18 :
152
152
sig
153
-
include r(Monad/21) with [resolved(root(Monad/21).t) = a]
153
+
include r(Monad/21) with [resolved(root(Monad/21).t)(params (a)) = a]
154
154
(sig :
155
155
val map/31 : (a) -> ((a) -> b) -> b
156
156
val join/32 : (a) -> a
···
186
186
module SwappedVars/44 :
187
187
sig
188
188
type t/50
189
-
include r(Monad_2/45) with [resolved(root(Monad_2/45).t) = [b * a] resolved(t/50)]
189
+
include r(Monad_2/45) with [resolved(root(Monad_2/45).t)(params (a, b)) = [b * a] resolved(t/50)]
190
190
(sig :
191
191
val map/51 : ([err * a] resolved(t/50)) -> f:((a) -> b) -> [err * b] resolved(t/50)
192
192
val join/52 : ([e * [e * a] resolved(t/50)] resolved(t/50)) -> [e * a] resolved(t/50)
···
219
219
module M/59 :
220
220
sig
221
221
type t/63
222
-
include r(S/60) with [resolved(root(S/60).t) = [(alias (poly_var [ `A of (a * b) ]) b)] resolved(t/63)]
222
+
include r(S/60) with [resolved(root(S/60).t)(params (a)) = [(alias (poly_var [ `A of (a * b) ]) b)] resolved(t/63)]
223
223
(sig :
224
224
val map/64 : ([(alias (poly_var [ `A of (a * b) ]) b)] resolved(t/63)) -> ((a) -> b) -> [(alias (poly_var [ `A of (b * b) ]) b)] resolved(t/63)
225
225
(removed=type (a) t = ([(alias (poly_var [ `A of (a * b) ]) b)] local(t/63,false)))