Further fixes for duplicate identifiers

jonludlam · jonludlam · commit b5ecda0c50bf · 2026-02-09T11:44:46.000Z
As well as during loading, we also have to handle `includes` with
potentially duplicate identifiers during `lang_of.ml`. This commit
moves the 'synthetic parent' functions into path.ml and uses them
both in cmti.ml and lang_of.ml
diff --git a/src/loader/cmti.ml b/src/loader/cmti.ml
@@ -33,19 +33,6 @@ type env = Cmi.env = {
 
 let read_module_expr : (env -> Identifier.Signature.t -> Identifier.LabelParent.t -> Typedtree.module_expr -> ModuleType.expr) ref = ref (fun _ _ _ _ -> failwith "unset")
 
-(* Counter for generating unique synthetic parents for include expressions.
-   Items inside an include's module type expression need a different parent
-   to avoid identifier conflicts with items in the enclosing signature. *)
-let include_parent_counter = ref 0
-
-(* Create a synthetic parent identifier for items inside an include's module
-   type expression. Uses a lowercase module name (illegal in normal OCaml)
-   to ensure no clashes with real identifiers. *)
-let make_include_parent (parent : Identifier.Signature.t) : Identifier.Signature.t =
-  incr include_parent_counter;
-  let name = Printf.sprintf "include%d_" !include_parent_counter in
-  (Identifier.Mk.module_ (parent, Odoc_model.Names.ModuleName.make_std name) :> Identifier.Signature.t)
-
 let opt_map f = function
   | None -> None
   | Some x -> Some (f x)
@@ -794,7 +781,7 @@ and read_include env parent incl =
      identifier conflicts with items in the enclosing signature. Items inside
      the include expression (like TypeSubstitutions) will get identifiers under
      this synthetic parent, which won't clash with the real parent's items. *)
-  let include_parent = make_include_parent parent in
+  let include_parent = Identifier.fresh_include_parent parent in
   let include_container = (include_parent :> Identifier.LabelParent.t) in
   let expr = read_module_type env include_parent include_container incl.incl_mod in
   let umty = Odoc_model.Lang.umty_of_mty expr in 
diff --git a/src/model/paths.ml b/src/model/paths.ml
@@ -624,6 +624,19 @@ module Identifier = struct
           `SourceLocationInternal (p, n))
   end
 
+  (* Counter for generating unique synthetic parents for include expressions.
+     Items inside an include's module type expression need a different parent
+     to avoid identifier conflicts with items in the enclosing signature. *)
+  let include_parent_counter = ref 0
+
+  (* Create a synthetic parent identifier for items inside an include's module
+     type expression. Uses a lowercase module name (illegal in normal OCaml)
+     to ensure no clashes with real identifiers. *)
+  let fresh_include_parent (parent : Signature.t) : Signature.t =
+    incr include_parent_counter;
+    let name = Printf.sprintf "include%d_" !include_parent_counter in
+    (Mk.module_ (parent, ModuleName.make_std name) :> Signature.t)
+
   module Hashtbl = struct
     module Any = Hashtbl.Make (Any)
     module ContainerPage = Hashtbl.Make (ContainerPage)
diff --git a/src/model/paths.mli b/src/model/paths.mli
@@ -345,6 +345,12 @@ module Identifier : sig
       SourcePage.t * LocalName.t ->
       [> `SourceLocationInternal of SourcePage.t * LocalName.t ] id
   end
+
+  (** Create a synthetic parent identifier for items inside an include's
+      module type expression. Uses a lowercase module name (illegal in normal
+      OCaml) to ensure no clashes with real identifiers. Each call returns a
+      fresh identifier. *)
+  val fresh_include_parent : Signature.t -> Signature.t
 end
 
 (** Normal OCaml paths (i.e. the ones present in types) *)
diff --git a/src/xref2/lang_of.ml b/src/xref2/lang_of.ml
@@ -649,7 +649,9 @@ and include_decl :
   (* Don't start shadowing within any signatures *)
   match d with
   | Alias p -> Alias (Path.module_ map p)
-  | ModuleType mty -> ModuleType (u_module_type_expr map identifier mty)
+  | ModuleType mty ->
+      let include_parent = Identifier.fresh_include_parent identifier in
+      ModuleType (u_module_type_expr map include_parent mty)
 
 and include_ parent map i =
   let open Component.Include in
