diff --git a/CHANGES.md b/CHANGES.md index 98a7e5590e..7268a114c3 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,7 +13,11 @@ Tags: ### Added - Display 'private' keyword for private type extensions (@gpetiot, #1019) + +### Fixed + - Fix rendering of polymorphic variants (@wikku, @panglesd, #971) +- Add references to extension declarations (@gpetiot, @panglesd, #949) # 2.3.0 diff --git a/doc/ocamldoc_differences.mld b/doc/ocamldoc_differences.mld index b32bc6d23f..a7ce7073a2 100644 --- a/doc/ocamldoc_differences.mld +++ b/doc/ocamldoc_differences.mld @@ -51,6 +51,7 @@ Additionally we support extra annotations: - [class-type] is a replacement for [classtype] - [exn] is recognised as [exception] - [extension] refers to a type extension +- [extension-decl] refers to the declaration point of an extension constructor - [field] is a replacement for [recfield] - [instance-variable] refers to instance variables - [label] refers to labels introduced in anchors diff --git a/doc/odoc_for_authors.mld b/doc/odoc_for_authors.mld index 99629e3acd..36a9d9d6d5 100644 --- a/doc/odoc_for_authors.mld +++ b/doc/odoc_for_authors.mld @@ -388,6 +388,7 @@ The prefixes supported are: - [method] - [constructor] (and the equivalent deprecated prefix [const]) - [extension] +- [extension-decl] for refering to the declaration point of an extension constructor - [field] (and the equivalent deprecated prefix [recfield]) - [instance-variable] - [section] (and the equivalent deprecated prefix [label]) - for referring to headings diff --git a/src/document/comment.ml b/src/document/comment.ml index 592cc26873..5fc683423d 100644 --- a/src/document/comment.ml +++ b/src/document/comment.ml @@ -43,6 +43,8 @@ module Reference = struct | `Field (r, s) -> render_resolved (r :> t) ^ "." ^ FieldName.to_string s | `Extension (r, s) -> render_resolved (r :> t) ^ "." ^ ExtensionName.to_string s + | `ExtensionDecl (r, _, s) -> + render_resolved (r :> t) ^ "." ^ ExtensionName.to_string s | `Exception (r, s) -> render_resolved (r :> t) ^ "." ^ ExceptionName.to_string s | `Value (r, s) -> render_resolved (r :> t) ^ "." ^ ValueName.to_string s @@ -73,6 +75,8 @@ module Reference = struct | `Field (p, f) -> render_unresolved (p :> t) ^ "." ^ FieldName.to_string f | `Extension (p, f) -> render_unresolved (p :> t) ^ "." ^ ExtensionName.to_string f + | `ExtensionDecl (p, f) -> + render_unresolved (p :> t) ^ "." ^ ExtensionName.to_string f | `Exception (p, f) -> render_unresolved (p :> t) ^ "." ^ ExceptionName.to_string f | `Value (p, f) -> render_unresolved (p :> t) ^ "." ^ ValueName.to_string f diff --git a/src/document/url.ml b/src/document/url.ml index 4dac33eb5b..e6ecd3202e 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -312,6 +312,17 @@ module Anchor = struct (ExtensionName.to_string name); kind; } + | { iv = `ExtensionDecl (parent, name, _); _ } -> + let page = Path.from_identifier (parent :> Path.any) in + let kind = `ExtensionDecl in + Ok + { + page; + anchor = + Format.asprintf "%a-%s" pp_kind kind + (ExtensionName.to_string name); + kind; + } | { iv = `Exception (parent, name); _ } -> let page = Path.from_identifier (parent :> Path.any) in let kind = `Exception in diff --git a/src/loader/implementation.ml b/src/loader/implementation.ml index b8a004efc6..86818a8637 100644 --- a/src/loader/implementation.ml +++ b/src/loader/implementation.ml @@ -451,6 +451,9 @@ let anchor_of_identifier id = | `Extension (parent, name) -> let anchor = anchor `Extension (ExtensionName.to_string name) in continue anchor parent + | `ExtensionDecl (parent, name, _) -> + let anchor = anchor `ExtensionDecl (ExtensionName.to_string name) in + continue anchor parent in anchor_of_identifier [] id |> String.concat "." diff --git a/src/model/paths.ml b/src/model/paths.ml index a7099e0321..abcdd92fd5 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -43,6 +43,7 @@ module Identifier = struct | `Constructor (_, name) -> ConstructorName.to_string name | `Field (_, name) -> FieldName.to_string name | `Extension (_, name) -> ExtensionName.to_string name + | `ExtensionDecl (_, _, name) -> ExtensionName.to_string name | `Exception (_, name) -> ExceptionName.to_string name | `CoreException name -> ExceptionName.to_string name | `Value (_, name) -> ValueName.to_string name @@ -80,6 +81,7 @@ module Identifier = struct | { iv = `ClassType (p, _); _ } | { iv = `Type (p, _); _ } | { iv = `Extension (p, _); _ } + | { iv = `ExtensionDecl (p, _, _); _ } | { iv = `Exception (p, _); _ } | { iv = `Value (p, _); _ } -> (p : signature :> label_parent) @@ -218,6 +220,18 @@ module Identifier = struct type t_pv = Id.extension_pv end + module ExtensionDecl = struct + type t = Paths_types.Identifier.extension_decl + + type t_pv = Paths_types.Identifier.extension_decl_pv + + let equal = equal + + let hash = hash + + let compare = compare + end + module Exception = struct type t = Id.exception_ type t_pv = Id.exception_pv @@ -471,6 +485,16 @@ module Identifier = struct [> `Extension of Signature.t * ExtensionName.t ] id = mk_parent ExtensionName.to_string "extn" (fun (p, n) -> `Extension (p, n)) + let extension_decl : + Signature.t * (ExtensionName.t * ExtensionName.t) -> + [> `ExtensionDecl of Signature.t * ExtensionName.t * ExtensionName.t ] + id = + mk_parent + (fun (n, m) -> + ExtensionName.to_string n ^ "." ^ ExtensionName.to_string m) + "extn-decl" + (fun (p, (n, m)) -> `ExtensionDecl (p, n, m)) + let exception_ : Signature.t * ExceptionName.t -> [> `Exception of Signature.t * ExceptionName.t ] id = @@ -850,6 +874,8 @@ module Reference = struct Identifier.Mk.constructor (parent_type_identifier s, n) | `Extension (p, q) -> Identifier.Mk.extension (parent_signature_identifier p, q) + | `ExtensionDecl (p, q, r) -> + Identifier.Mk.extension_decl (parent_signature_identifier p, (q, r)) | `Exception (p, q) -> Identifier.Mk.exception_ (parent_signature_identifier p, q) | `Value (p, q) -> Identifier.Mk.value (parent_signature_identifier p, q) @@ -904,6 +930,10 @@ module Reference = struct type t = Paths_types.Resolved_reference.extension end + module ExtensionDecl = struct + type t = Paths_types.Resolved_reference.extension_decl + end + module Exception = struct type t = Paths_types.Resolved_reference.exception_ end @@ -985,6 +1015,10 @@ module Reference = struct type t = Paths_types.Reference.extension end + module ExtensionDecl = struct + type t = Paths_types.Reference.extension_decl + end + module Exception = struct type t = Paths_types.Reference.exception_ end diff --git a/src/model/paths.mli b/src/model/paths.mli index 7e1a25b597..f8fd9aa972 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -104,6 +104,18 @@ module Identifier : sig type t_pv = Id.extension_pv end + module ExtensionDecl : sig + type t = Paths_types.Identifier.extension_decl + + type t_pv = Paths_types.Identifier.extension_decl_pv + + val equal : t -> t -> bool + + val hash : t -> int + + val compare : t -> t -> int + end + module Exception : sig type t = Id.exception_ type t_pv = Id.exception_pv @@ -274,6 +286,14 @@ module Identifier : sig Signature.t * ExtensionName.t -> [> `Extension of Signature.t * ExtensionName.t ] id + val extension_decl : + Signature.t * (ExtensionName.t * ExtensionName.t) -> + [> `ExtensionDecl of Signature.t * ExtensionName.t * ExtensionName.t ] id + (** [extension_decl (sg, e1, eN)] defines an extension declaration where [sg] is the parent, + [e1] is the first constructor of the extension, and [eN] is the constructor the Id is created for. + [e1] will be used for the url, and [eN] will be the one displayed. + The first constructor of the extension will always be used to reference the extension point. *) + val exception_ : Signature.t * ExceptionName.t -> [> `Exception of Signature.t * ExceptionName.t ] id @@ -475,6 +495,10 @@ module rec Reference : sig type t = Paths_types.Resolved_reference.extension end + module ExtensionDecl : sig + type t = Paths_types.Resolved_reference.extension_decl + end + module Exception : sig type t = Paths_types.Resolved_reference.exception_ end @@ -556,6 +580,10 @@ module rec Reference : sig type t = Paths_types.Reference.extension end + module ExtensionDecl : sig + type t = Paths_types.Reference.extension_decl + end + module Exception : sig type t = Paths_types.Reference.exception_ end diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index 70a838496c..aa34f0fda9 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -147,9 +147,16 @@ module Identifier = struct type extension_pv = [ `Extension of signature * ExtensionName.t ] (** @canonical Odoc_model.Paths.Identifier.Extension.t_pv *) + type extension_decl_pv = + [ `ExtensionDecl of signature * ExtensionName.t * ExtensionName.t ] + (** @canonical Odoc_model.Paths.Identifier.ExtensionDecl.t_pv *) + and extension = extension_pv id (** @canonical Odoc_model.Paths.Identifier.Extension.t *) + and extension_decl = extension_decl_pv id + (** @canonical Odoc_model.Paths.Identifier.ExtensionDecl.t *) + type exception_pv = [ `Exception of signature * ExceptionName.t | `CoreException of ExceptionName.t ] @@ -209,6 +216,7 @@ module Identifier = struct | constructor_pv | field_pv | extension_pv + | extension_decl_pv | exception_pv | value_pv | class_pv @@ -275,6 +283,8 @@ module Identifier = struct type reference_extension = [ extension_pv | exception_pv ] id + type reference_extension_decl = extension_decl + type reference_exception = exception_ type reference_value = value @@ -508,6 +518,7 @@ module rec Reference : sig | `TConstructor | `TField | `TExtension + | `TExtensionDecl | `TException | `TValue | `TClass @@ -632,6 +643,13 @@ module rec Reference : sig | `Exception of signature * ExceptionName.t ] (** @canonical Odoc_model.Paths.Reference.Extension.t *) + type extension_decl = + [ `Resolved of Resolved_reference.extension_decl + | `Root of string * [ `TExtension | `TException | `TUnknown ] + | `Dot of label_parent * string + | `ExtensionDecl of signature * ExtensionName.t ] + (** @canonical Odoc_model.Paths.Reference.ExtensionDecl.t *) + type exception_ = [ `Resolved of Resolved_reference.exception_ | `Root of string * [ `TException | `TUnknown ] @@ -698,6 +716,7 @@ module rec Reference : sig | `Constructor of datatype * ConstructorName.t | `Field of parent * FieldName.t | `Extension of signature * ExtensionName.t + | `ExtensionDecl of signature * ExtensionName.t | `Exception of signature * ExceptionName.t | `Value of signature * ValueName.t | `Class of signature * ClassName.t @@ -801,6 +820,16 @@ and Resolved_reference : sig | `Exception of signature * ExceptionName.t ] (** @canonical Odoc_model.Paths.Reference.Resolved.Extension.t *) + type extension_decl = + [ `Identifier of Identifier.reference_extension_decl + | `ExtensionDecl of + signature + * ExtensionName.t + (* The extension_name used in the url. + It is the extension_name of the first constructor of the extension (there is always at least 1). *) + * ExtensionName.t (* displayed *) ] + (** @canonical Odoc_model.Paths.Reference.Resolved.Extension.t *) + type exception_ = [ `Identifier of Identifier.reference_exception | `Exception of signature * ExceptionName.t ] @@ -851,6 +880,7 @@ and Resolved_reference : sig | `Constructor of datatype * ConstructorName.t | `Field of parent * FieldName.t | `Extension of signature * ExtensionName.t + | `ExtensionDecl of signature * ExtensionName.t * ExtensionName.t | `Exception of signature * ExceptionName.t | `Value of signature * ValueName.t | `Class of signature * ClassName.t diff --git a/src/model/reference.ml b/src/model/reference.ml index 25c481507d..57e690ad1c 100644 --- a/src/model/reference.ml +++ b/src/model/reference.ml @@ -68,6 +68,7 @@ let match_extra_odoc_reference_kind (_location as loc) s : d loc "exn" "exception"; Some `TException | Some "extension" -> Some `TExtension + | Some "extension-decl" -> Some `TExtensionDecl | Some "field" -> Some `TField | Some "instance-variable" -> Some `TInstanceVariable | Some "label" -> @@ -365,6 +366,9 @@ let parse whole_reference_location s : | `TExtension -> `Extension (signature next_token tokens, ExtensionName.make_std identifier) + | `TExtensionDecl -> + `ExtensionDecl + (signature next_token tokens, ExtensionName.make_std identifier) | `TException -> `Exception (signature next_token tokens, ExceptionName.make_std identifier) diff --git a/src/model_desc/paths_desc.ml b/src/model_desc/paths_desc.ml index 0a42a9d4ed..d9a785f310 100644 --- a/src/model_desc/paths_desc.ml +++ b/src/model_desc/paths_desc.ml @@ -130,6 +130,11 @@ module General_paths = struct ( "`Extension", ((parent :> id_t), name), Pair (identifier, Names.extensionname) ) + | `ExtensionDecl (parent, name, name') -> + C + ( "`ExtensionDecl", + ((parent :> id_t), name, name'), + Triple (identifier, Names.extensionname, Names.extensionname) ) | `Exception (parent, name) -> C ( "`Exception", @@ -184,6 +189,7 @@ module General_paths = struct | `TConstructor -> C0 "`TConstructor" | `TException -> C0 "`TException" | `TExtension -> C0 "`TExtension" + | `TExtensionDecl -> C0 "`TExtensionDecl" | `TField -> C0 "`TField" | `TInstanceVariable -> C0 "`TInstanceVariable" | `TLabel -> C0 "`TLabel" @@ -294,6 +300,11 @@ module General_paths = struct ( "`Extension", ((x1 :> r), x2), Pair (reference, Names.extensionname) ) + | `ExtensionDecl (x1, x2) -> + C + ( "`ExtensionDecl", + ((x1 :> r), x2), + Pair (reference, Names.extensionname) ) | `Exception (x1, x2) -> C ( "`Exception", @@ -346,6 +357,13 @@ module General_paths = struct ( "`Extension", ((x1 :> rr), x2), Pair (resolved_reference, Names.extensionname) ) + | `ExtensionDecl (x1, x2, x3) -> + C + ( "`ExtensionDecl", + ((x1 :> rr), x2, x3), + Triple + (resolved_reference, Names.extensionname, Names.extensionname) + ) | `Field (x1, x2) -> C ( "`Field", diff --git a/src/xref2/component.ml b/src/xref2/component.ml index 0fb9a9723f..b6b6add3e1 100644 --- a/src/xref2/component.ml +++ b/src/xref2/component.ml @@ -510,7 +510,11 @@ module Element = struct type exception_ = [ `Exception of Identifier.Exception.t * Exception.t ] type extension = - [ `Extension of Identifier.Extension.t * Extension.Constructor.t ] + [ `Extension of + Identifier.Extension.t * Extension.Constructor.t * Extension.t ] + + type extension_decl = + [ `ExtensionDecl of Identifier.Extension.t * Extension.Constructor.t ] type field = [ `Field of Identifier.Field.t * TypeDecl.Field.t ] @@ -529,6 +533,7 @@ module Element = struct | constructor | exception_ | extension + | extension_decl | field | page ] @@ -545,7 +550,8 @@ module Element = struct | `Constructor (id, _) -> (id :> t) | `Exception (id, _) -> (id :> t) | `Field (id, _) -> (id :> t) - | `Extension (id, _) -> (id :> t) + | `Extension (id, _, _) -> (id :> t) + | `ExtensionDecl (id, _) -> (id :> t) | `Page (id, _) -> (id :> t) end @@ -1245,6 +1251,10 @@ module Fmt = struct Format.fprintf ppf "%a.%s" model_identifier (p :> Odoc_model.Paths.Identifier.t) (ExtensionName.to_string name) + | `ExtensionDecl (p, _, name) -> + Format.fprintf ppf "%a.%s" model_identifier + (p :> Odoc_model.Paths.Identifier.t) + (ExtensionName.to_string name) | `Page (_, name) | `LeafPage (_, name) -> Format.fprintf ppf "%s" (PageName.to_string name) | `SourcePage (p, name) | `SourceDir (p, name) -> @@ -1411,6 +1421,10 @@ module Fmt = struct Format.fprintf ppf "%a.%s" model_resolved_reference (parent :> t) (ExtensionName.to_string name) + | `ExtensionDecl (parent, name, _) -> + Format.fprintf ppf "%a.%s" model_resolved_reference + (parent :> t) + (ExtensionName.to_string name) | `Exception (parent, name) -> Format.fprintf ppf "%a.%s" model_resolved_reference (parent :> t) @@ -1481,6 +1495,10 @@ module Fmt = struct Format.fprintf ppf "%a.%s" model_reference (parent :> t) (ExtensionName.to_string name) + | `ExtensionDecl (parent, name) -> + Format.fprintf ppf "%a.%s" model_reference + (parent :> t) + (ExtensionName.to_string name) | `Exception (parent, name) -> Format.fprintf ppf "%a.%s" model_reference (parent :> t) diff --git a/src/xref2/component.mli b/src/xref2/component.mli index bc289ad73e..363be1b2df 100644 --- a/src/xref2/component.mli +++ b/src/xref2/component.mli @@ -478,7 +478,11 @@ module Element : sig type exception_ = [ `Exception of Identifier.Exception.t * Exception.t ] type extension = - [ `Extension of Identifier.Extension.t * Extension.Constructor.t ] + [ `Extension of + Identifier.Extension.t * Extension.Constructor.t * Extension.t ] + + type extension_decl = + [ `ExtensionDecl of Identifier.Extension.t * Extension.Constructor.t ] type field = [ `Field of Identifier.Field.t * TypeDecl.Field.t ] @@ -497,6 +501,7 @@ module Element : sig | constructor | exception_ | extension + | extension_decl | field | page ] diff --git a/src/xref2/env.ml b/src/xref2/env.ml index 703f97a71a..23d5df1150 100644 --- a/src/xref2/env.ml +++ b/src/xref2/env.ml @@ -351,8 +351,8 @@ let add_exception identifier (e : Component.Exception.t) env = |> add_cdocs identifier e.doc let add_extension_constructor identifier - (ec : Component.Extension.Constructor.t) env = - add_to_elts Kind_Extension identifier (`Extension (identifier, ec)) env + (ec : Component.Extension.Constructor.t) te env = + add_to_elts Kind_Extension identifier (`Extension (identifier, ec, te)) env |> add_cdocs identifier ec.doc let module_of_unit : Lang.Compilation_unit.t -> Component.Module.t = @@ -531,7 +531,11 @@ let s_any : Component.Element.any scope = :> Component.Element.any amb_err) with Not_found -> None) | _ -> None) - (fun r -> Some r) + (function + (* Reference to [A] could refer to [extension-A] or [extension-decl-A]. + The legacy behavior refers to the constructor [extension-A]. *) + | #Component.Element.extension_decl -> None + | r -> Some r) let s_module_type : Component.Element.module_type scope = make_scope (function @@ -722,10 +726,12 @@ let rec open_signature : Lang.Signature.t -> t -> t = | Comment c, true -> add_comment c env | TypExt te, true -> let doc = docs ident_map te.doc in + let te' = extension ident_map te in List.fold_left (fun env tec -> let ty = extension_constructor ident_map tec in - add_extension_constructor tec.L.Extension.Constructor.id ty env) + add_extension_constructor tec.L.Extension.Constructor.id ty te' + env) env te.L.Extension.constructors |> add_cdocs te.L.Extension.parent doc | Exception e, true -> diff --git a/src/xref2/env.mli b/src/xref2/env.mli index 658c9f332f..72aa01ae48 100644 --- a/src/xref2/env.mli +++ b/src/xref2/env.mli @@ -71,7 +71,11 @@ val add_class_type : Identifier.ClassType.t -> Component.ClassType.t -> t -> t val add_exception : Identifier.Exception.t -> Component.Exception.t -> t -> t val add_extension_constructor : - Identifier.Extension.t -> Component.Extension.Constructor.t -> t -> t + Identifier.Extension.t -> + Component.Extension.Constructor.t -> + Component.Extension.t -> + t -> + t val add_docs : Comment.docs -> t -> t diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index 6143fb41f1..f3ac027c94 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -68,6 +68,7 @@ let ref_kind_of_element = function | `Constructor _ -> "constructor" | `Exception _ -> "exception" | `Extension _ -> "extension" + | `ExtensionDecl _ -> "extension-decl" | `Field _ -> "field" | `Page _ -> "page" @@ -82,6 +83,7 @@ let ref_kind_of_find = function | `FConstructor _ | `In_type (_, _, `FConstructor _) -> "constructor" | `FExn _ -> "exception" | `FExt _ -> "extension" + | `FExtDecl _ -> "extension-decl" | `FField _ | `In_type (_, _, `FField _) -> "field" | `FMethod _ -> "method" | `FInstance_variable _ -> "instance-variable" @@ -375,8 +377,8 @@ module EC = struct type t = Resolved.Constructor.t let in_env env name = - env_lookup_by_name Env.s_extension name env >>= fun (`Extension (id, _)) -> - Ok (`Identifier id :> t) + env_lookup_by_name Env.s_extension name env + >>= fun (`Extension (id, _, _)) -> Ok (`Identifier id :> t) let of_component _env ~parent_ref name = Ok (`Extension (parent_ref, ExtensionName.make_std name)) @@ -388,6 +390,37 @@ module EC = struct Ok (`Extension (parent', name)) end +module ED = struct + (** Extension decl *) + + let in_env env name = + env_lookup_by_name Env.s_extension name env + >>= fun (`Extension (id, _, te)) -> + (* Type extensions always have at least 1 constructor. + The reference to the type extension shares the same name as the first constructor. *) + match te.constructors with + | [] -> assert false + | c :: _ -> + let id_parent = match id.iv with `Extension (p, _) -> p in + Ok + (`Identifier + (Identifier.Mk.extension_decl + ( id_parent, + (ExtensionName.make_std c.name, ExtensionName.make_std name) ))) + + let in_signature _env ((parent', parent_cp, sg) : signature_lookup_result) + name = + let sg = Tools.prefix_signature (parent_cp, sg) in + find Find.extension_in_sig sg (ExtensionName.to_string name) + >>= fun (`FExt (ext, _) : Find.extension) -> + (* Type extensions always have at least 1 constructor. + The reference to the type extension shares the same name as the first constructor. *) + match ext.constructors with + | [] -> assert false + | c :: _ -> + Ok (`ExtensionDecl (parent', ExtensionName.make_std c.name, name)) +end + module EX = struct (** Exception *) @@ -746,7 +779,8 @@ let resolve_reference = | `ClassType (id, _) -> identifier id | `Constructor (id, _) -> identifier id | `Exception (id, _) -> identifier id - | `Extension (id, _) -> identifier id + | `Extension (id, _, _) -> identifier id + | `ExtensionDecl (id, _) -> identifier id | `Field (id, _) -> identifier id | `Page (id, _) -> identifier id) | `Resolved r -> Ok r @@ -794,6 +828,10 @@ let resolve_reference = | `Extension (parent, name) -> resolve_signature_reference env parent >>= fun p -> EC.in_signature env p name >>= resolved1 + | `Root (name, `TExtensionDecl) -> ED.in_env env name >>= resolved1 + | `ExtensionDecl (parent, name) -> + resolve_signature_reference env parent >>= fun p -> + ED.in_signature env p name >>= resolved1 | `Root (name, `TField) -> F.in_env env name >>= resolved1 | `Field (parent, name) -> resolve_label_parent_reference env (parent : Parent.t :> LabelParent.t) diff --git a/src/xref2/shape_tools.ml b/src/xref2/shape_tools.ml index 626816a56c..c702e17b56 100644 --- a/src/xref2/shape_tools.ml +++ b/src/xref2/shape_tools.ml @@ -40,6 +40,8 @@ let rec shape_of_id env : | `Value (parent, name) -> proj parent Kind.Value (ValueName.to_string name) | `Extension (parent, name) -> proj parent Kind.Extension_constructor (ExtensionName.to_string name) + | `ExtensionDecl (parent, name, _) -> + proj parent Kind.Extension_constructor (ExtensionName.to_string name) | `Exception (parent, name) -> proj parent Kind.Extension_constructor (ExceptionName.to_string name) | `Class (parent, name) -> proj parent Kind.Class (ClassName.to_string name) diff --git a/test/xref2/github_issue_932.t/foo.mli b/test/xref2/github_issue_932.t/foo.mli new file mode 100644 index 0000000000..5aa8db0557 --- /dev/null +++ b/test/xref2/github_issue_932.t/foo.mli @@ -0,0 +1,32 @@ +(* Consider this extensible type *) + +type t = .. + +type t += +| A +| B + +module M : sig + type t = .. + + type t += + | A + | B +end + +type M.t += C + +(** - t : {!t} + - extension-decl-A : {!extension-decl-A} + - extension-decl-B : {!extension-decl-B} + - extension-A : {!extension-A} + - extension-B : {!extension-B} + - A : {!A} + + - M.t : {!M.t} + - M.extension-decl-A : {!M.extension-decl-A} + - M.extension-decl-B : {!M.extension-decl-B} + - M.extension-A : {!M.extension-A} + - M.extension-B : {!M.extension-B} + - M.A : {!M.A} + *) diff --git a/test/xref2/github_issue_932.t/run.t b/test/xref2/github_issue_932.t/run.t new file mode 100644 index 0000000000..1e1834b25a --- /dev/null +++ b/test/xref2/github_issue_932.t/run.t @@ -0,0 +1,67 @@ +A quick test to repro the issue found in #941 + + $ ocamlc -bin-annot -c foo.mli + + $ odoc compile foo.cmti + $ odoc link foo.odoc + + $ odoc html-generate --indent -o html/ foo.odocl + +The rendered html + + $ cat html/Foo/index.html | grep "extension" -A 3 +
+ + + type t += + + -- +
  • + + | A + +
    • +
  • + + | B + +
    • + + -- +
    + + + type + M.t += + -- +
  • + + | C + +
    • + + -- +
  • extension-decl-A : A +
    • +
  • extension-decl-B : B +
  • extension-A : A
    • +
  • extension-B : B
    • +
  • A : A
    • + +
    • M.t : M.t
      • +
    • M.extension-decl-A : + M.A +
      • +
    • M.extension-decl-B : + M.B +
      • +
    • M.extension-A : + M.A +
      • +
    • M.extension-B : + M.B +
      • +
    • M.A : M.A
      • +
    +
    +