Merge pull request #1865 from voodoos/fix-occurrences-no-sources

Fix occurrences when the definition's source is hidden

CHANGES.md

@@ -10,6 +10,8 @@ unreleased
     - Fix jump to `fun` targets not working (#1863, fixes #1862)
     - Fix type-enclosing results instability. This reverts some overly
       aggressive deduplication that should be done on the client side. (#1864)
+    - Fix occurrences not working when the definition comes from a hidden source
+      file (#1865)
 
 merlin 5.2.1
 ============

src/analysis/locate.ml

@@ -643,7 +643,14 @@ let from_path ~config ~env ~local_defs ~decl path =
       log ~title:"find_source" "Found file: %s (%a)" file Logger.fmt
         (Fun.flip Location.print_loc location);
       `Found { uid; decl_uid = decl.uid; file; location; approximated }
-    | `File_not_found _ as otherwise -> otherwise)
+    | `File_not_found reason ->
+      `File_not_found
+        { uid;
+          decl_uid = decl.uid;
+          file = reason;
+          location = loc;
+          approximated
+        })
 
 let from_longident ~config ~env ~local_defs nss ident =
   let str_ident =
@@ -851,21 +858,25 @@ let get_doc ~config:mconfig ~env ~local_defs ~comments ~pos =
         let from_path = from_path ~config ~env ~local_defs ~namespace path in
         begin
           match from_path with
-          | `Found { uid; location = loc; _ } -> doc_from_uid ~config ~loc uid
-          | (`Builtin _ | `Not_in_env _ | `File_not_found _ | `Not_found _) as
-            otherwise -> otherwise
+          | `Found { uid; location = loc; _ }
+          | `File_not_found { uid; location = loc; _ } ->
+            doc_from_uid ~config ~loc uid
+          | (`Builtin _ | `Not_in_env _ | `Not_found _) as otherwise ->
+            otherwise
         end
       | `User_input path ->
         log ~title:"get_doc" "looking for the doc of '%s'" path;
         begin
           match from_string ~config ~env ~local_defs ~pos path with
-          | `Found { uid; location = loc; _ } -> doc_from_uid ~config ~loc uid
+          | `Found { uid; location = loc; _ }
+          | `File_not_found { uid; location = loc; _ } ->
+            doc_from_uid ~config ~loc uid
           | `At_origin ->
             `Found_loc
               { Location.loc_start = pos; loc_end = pos; loc_ghost = true }
           | `Missing_labels_namespace -> `No_documentation
-          | (`Builtin _ | `Not_in_env _ | `Not_found _ | `File_not_found _) as
-            otherwise -> otherwise
+          | (`Builtin _ | `Not_in_env _ | `Not_found _) as otherwise ->
+            otherwise
         end
     in
     match doc_from_uid_result with
@@ -901,5 +912,5 @@ let get_doc ~config:mconfig ~env ~local_defs ~comments ~pos =
       | `User_input path -> `Builtin path
       | `Completion_entry (_, path, _) -> `Builtin (Path.name path)
     end
-    | (`File_not_found _ | `Not_found _ | `No_documentation | `Not_in_env _) as
-      otherwise -> otherwise
+    | (`Not_found _ | `No_documentation | `Not_in_env _) as otherwise ->
+      otherwise

src/analysis/locate.mli

@@ -54,7 +54,7 @@ val from_path :
   local_defs:Mtyper.typedtree ->
   namespace:Env_lookup.Namespace.t ->
   Path.t ->
-  [> `File_not_found of string
+  [> `File_not_found of result
   | `Found of result
   | `Builtin of Shape.Uid.t * string
   | `Not_in_env of string
@@ -67,7 +67,7 @@ val from_string :
   pos:Lexing.position ->
   ?namespaces:Env_lookup.Namespace.inferred_basic list ->
   string ->
-  [> `File_not_found of string
+  [> `File_not_found of result
   | `Found of result
   | `Builtin of Shape.Uid.t * string
   | `Missing_labels_namespace
@@ -83,8 +83,7 @@ val get_doc :
   pos:Lexing.position ->
   [ `User_input of string
   | `Completion_entry of Env_lookup.Namespace.t * Path.t * Location.t ] ->
-  [> `File_not_found of string
-  | `Found of string
+  [> `Found of string
   | `Builtin of string
   | `Not_found of string * string option
   | `Not_in_env of string

src/analysis/occurrences.ml

@@ -151,7 +151,8 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path =
         | _ -> scope
       in
       (node_uid_loc, scope)
-    | `Found { uid; location; approximated = false; _ } ->
+    | `Found { uid; location; approximated = false; _ }
+    | `File_not_found { uid; location; approximated = false; _ } ->
       log ~title:"locs_of" "Found definition uid using locate: %a " Logger.fmt
         (fun fmt -> Shape.Uid.print fmt uid);
       (* There is no way to distinguish uids from interfaces from uids of
@@ -161,7 +162,8 @@ let locs_of ~config ~env ~typer_result ~pos ~scope path =
          are actually linked. *)
       let scope = if is_in_interface config location then `Buffer else scope in
       (Some (uid, location), scope)
-    | `Found { decl_uid; location; approximated = true; _ } ->
+    | `Found { decl_uid; location; approximated = true; _ }
+    | `File_not_found { decl_uid; location; approximated = true; _ } ->
       log ~title:"locs_of" "Approx. definition: %a " Logger.fmt (fun fmt ->
           Shape.Uid.print fmt decl_uid);
       (Some (decl_uid, location), `Buffer)

src/frontend/query_commands.ml

@@ -349,7 +349,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
         | `Not_in_env _ as s -> s
         | `Not_found _ as s -> s
         | `Found { file; location; _ } -> `Found (Some file, location.loc_start)
-        | `File_not_found _ as s -> s)
+        | `File_not_found { file = reason; _ } -> `File_not_found reason)
     end
   | Complete_prefix (prefix, pos, kinds, with_doc, with_types) ->
     let pipeline, typer = for_completion pipeline pos in
@@ -527,8 +527,8 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function
         | `Builtin (_, s) ->
           Locate.log ~title:"result" "found builtin %s" s;
           `Builtin s
-        | (`Not_found _ | `At_origin | `Not_in_env _ | `File_not_found _) as
-          otherwise ->
+        | `File_not_found { file = reason; _ } -> `File_not_found reason
+        | (`Not_found _ | `At_origin | `Not_in_env _) as otherwise ->
           Locate.log ~title:"result" "not found";
           otherwise
       end

tests/test-dirs/occurrences/no-def-mli-only.t

@@ -0,0 +1,47 @@
+  $ cat >noml.mli <<'EOF'
+  > type t = unit
+  > EOF
+
+  $ cat >noml.ml <<'EOF'
+  > type t = unit
+  > EOF
+
+  $ cat >main.ml <<'EOF'
+  > let x : Noml.t = ()
+  > let y : Noml.t = ()
+  > EOF
+
+  $ $OCAMLC -c -bin-annot noml.mli noml.ml main.ml
+
+We remove the source file to mimick cases were generated source files are not
+accessible to Merlin.
+  $ rm noml.ml
+
+We still expect occurrences of definitions in hidden source files to work
+  $ $MERLIN single occurrences -identifier-at 2:13 -filename main.ml <main.ml  
+  {
+    "class": "return",
+    "value": [
+      {
+        "start": {
+          "line": 1,
+          "col": 13
+        },
+        "end": {
+          "line": 1,
+          "col": 14
+        }
+      },
+      {
+        "start": {
+          "line": 2,
+          "col": 13
+        },
+        "end": {
+          "line": 2,
+          "col": 14
+        }
+      }
+    ],
+    "notifications": []
+  }