Fix occurrences for extension constructors

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 =

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 :

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 =

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
 

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 <main.ml 
-  {
-    "class": "exception",
-    "value": "File \"src/analysis/browse_tree.ml\", line 88, characters 15-21: Assertion failed
-  Raised at Merlin_analysis__Browse_tree.same_constructor.get_decls in file \"src/analysis/browse_tree.ml\", line 88, characters 15-27
-  Called from Merlin_analysis__Browse_tree.same_constructor in file \"src/analysis/browse_tree.ml\", line 93, characters 12-23
-  Called from Merlin_analysis__Browse_tree.all_constructor_occurrences.aux in file \"src/analysis/browse_tree.ml\", line 117, characters 14-52
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Stdlib__List.fold_left in file \"list.ml\", line 121, characters 24-34
-  Called from Query_commands.dispatch.constructor_occurrence in file \"src/frontend/query_commands.ml\", line 829, characters 15-72
-  Called from Dune__exe__New_commands.run in file \"src/frontend/ocamlmerlin/new/new_commands.ml\", line 65, characters 15-53
-  Called from Merlin_utils__Std.let_ref in file \"src/utils/std.ml\", line 693, characters 8-12
-  Re-raised at Merlin_utils__Std.let_ref in file \"src/utils/std.ml\", line 695, characters 30-39
-  Called from Merlin_utils__Misc.try_finally in file \"src/utils/misc.ml\", line 45, characters 8-15
-  Re-raised at Merlin_utils__Misc.try_finally in file \"src/utils/misc.ml\", line 62, characters 10-24
-  Called from Stdlib__Fun.protect in file \"fun.ml\", line 33, characters 8-15
-  Re-raised at Stdlib__Fun.protect in file \"fun.ml\", line 38, characters 6-52
-  Called from Merlin_kernel__Mocaml.with_state in file \"src/kernel/mocaml.ml\", line 18, characters 8-38
-  Re-raised at Merlin_kernel__Mocaml.with_state in file \"src/kernel/mocaml.ml\", line 20, characters 42-53
-  Called from Dune__exe__New_merlin.run.(fun) in file \"src/frontend/ocamlmerlin/new/new_merlin.ml\", line 101, characters 14-110
-  ",
-    "notifications": []
-  }
+  > -filename main.ml <main.ml | jq '.value'
+  [
+    {
+      "start": {
+        "line": 2,
+        "col": 10
+      },
+      "end": {
+        "line": 2,
+        "col": 11
+      }
+    },
+    {
+      "start": {
+        "line": 5,
+        "col": 2
+      },
+      "end": {
+        "line": 5,
+        "col": 3
+      }
+    }
+  ]