diff --git a/CHANGES.md b/CHANGES.md index 2b20a7fa70..6b62ee9f40 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,6 +13,7 @@ unreleased - Support parsing negative numbers in sexps (#1655) - Fix construct not working with inline records (#1658) - Improve behavior of `type-enclosing` on let/and operators (#1653) + - Fix occurrences of extension constructors (#1662) + editor modes - emacs: call merlin-client-logger with "interrupted" if the merlin binary itself is interrupted, not just the parsing of the 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 442763c5de..3b1e766388 100644 --- a/src/ocaml/merlin_specific/browse_raw.ml +++ b/src/ocaml/merlin_specific/browse_raw.ml @@ -933,6 +933,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 f80d4826f8..7708eae16c 100644 --- a/src/ocaml/merlin_specific/browse_raw.mli +++ b/src/ocaml/merlin_specific/browse_raw.mli @@ -116,7 +116,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 new file mode 100644 index 0000000000..0ca6ff38e6 --- /dev/null +++ b/tests/test-dirs/occurrences/ext-variant.t @@ -0,0 +1,73 @@ +See issue #1185 on vscode-ocaml-platform + + $ cat >main.ml < (*type t = ..*) + > type t = A + > + > let foo (x : t) = match x with + > | A -> 1 + > | _ -> 0 + > EOF + + $ $MERLIN single occurrences -identifier-at 5:2 \ + > -filename main.ml main.ml < type t = .. + > type t += A + > + > let foo (x : t) = match x with + > | A -> 1 + > | _ -> 0 + > EOF + +FIXME: we can do better than that + $ $MERLIN single occurrences -identifier-at 5:2 \ + > -log-file - -log-section occurrences \ + > -filename main.ml