diff --git a/src/analysis/browse_tree.ml b/src/analysis/browse_tree.ml index 79afd4057f..aa2ebb0d34 100644 --- a/src/analysis/browse_tree.ml +++ b/src/analysis/browse_tree.ml @@ -70,12 +70,13 @@ and normalize_type_decl env decl = match decl.Types.type_manifest with | Some expr -> normalize_type_expr env expr | None -> decl -let id_of_constr_decl c = c.Types.cd_id +let id_of_constr_decl c = `Id c.Types.cd_id let same_constructor env a b = let name = function | `Description d -> d.Types.cstr_name | `Declaration d -> Ident.name d.Typedtree.cd_id + | `Extension_constructor ec -> Ident.name ec.Typedtree.ext_id in if name a <> name b then false else begin @@ -85,14 +86,24 @@ let same_constructor env a b = begin match ty.Types.type_kind with | Types.Type_variant (decls, _) -> List.map decls ~f:id_of_constr_decl + | Type_open -> + [`Uid d.cstr_uid] | _ -> assert false end | `Declaration d -> - [d.Typedtree.cd_id] + [`Id d.Typedtree.cd_id] + | `Extension_constructor ext_cons -> + let des = Env.find_ident_constructor ext_cons.Typedtree.ext_id env in + [`Uid des.cstr_uid] in let a = get_decls a in let b = get_decls b in - List.exists a ~f:(fun id -> List.exists b ~f:(Ident.same id)) + let same a b = match a, b with + | `Id a, `Id b -> Ident.same a b + | `Uid a, `Uid b -> Shape.Uid.equal a b + | _, _ -> false + in + List.exists a ~f:(fun id -> List.exists b ~f:(same id)) end let all_occurrences path = diff --git a/src/analysis/browse_tree.mli b/src/analysis/browse_tree.mli index 24284e8350..66713bba13 100644 --- a/src/analysis/browse_tree.mli +++ b/src/analysis/browse_tree.mli @@ -48,7 +48,8 @@ val dummy : t val all_occurrences : Path.t -> t -> (t * Path.t Location.loc list) list val all_constructor_occurrences : t * [ `Description of Types.constructor_description - | `Declaration of Typedtree.constructor_declaration ] + | `Declaration of Typedtree.constructor_declaration + | `Extension_constructor of Typedtree.extension_constructor ] -> t -> t Location.loc list val all_occurrences_of_prefix : diff --git a/src/ocaml/merlin_specific/browse_raw.ml b/src/ocaml/merlin_specific/browse_raw.ml index a737f6eec6..de478c1a20 100644 --- a/src/ocaml/merlin_specific/browse_raw.ml +++ b/src/ocaml/merlin_specific/browse_raw.ml @@ -919,6 +919,9 @@ let node_is_constructor = function Some {loc with Location.txt = `Description desc} | Pattern {pat_desc = Tpat_construct (loc, desc, _, _)} -> Some {loc with Location.txt = `Description desc} + | Extension_constructor ext_cons -> + Some { Location.loc = ext_cons.ext_loc; + txt = `Extension_constructor ext_cons} | _ -> None let node_of_binary_part env part = diff --git a/src/ocaml/merlin_specific/browse_raw.mli b/src/ocaml/merlin_specific/browse_raw.mli index 0e919a9542..526199634a 100644 --- a/src/ocaml/merlin_specific/browse_raw.mli +++ b/src/ocaml/merlin_specific/browse_raw.mli @@ -115,7 +115,9 @@ val node_paths_and_longident : node -> (Path.t Location.loc * Longident.t) list val node_is_constructor : node -> [ `Description of Types.constructor_description - | `Declaration of Typedtree.constructor_declaration ] Location.loc option + | `Declaration of Typedtree.constructor_declaration + | `Extension_constructor of Typedtree.extension_constructor ] + Location.loc option val node_of_binary_part : Env.t -> Cmt_format.binary_part -> node diff --git a/tests/test-dirs/occurrences/ext-variant.t b/tests/test-dirs/occurrences/ext-variant.t index d005a02630..0ca6ff38e6 100644 --- a/tests/test-dirs/occurrences/ext-variant.t +++ b/tests/test-dirs/occurrences/ext-variant.t @@ -47,33 +47,27 @@ See issue #1185 on vscode-ocaml-platform FIXME: we can do better than that $ $MERLIN single occurrences -identifier-at 5:2 \ > -log-file - -log-section occurrences \ - > -filename main.ml -filename main.ml