Merge pull request #1364 from ocaml/locate-state-reset

[locate] reset state from entry points

Author: trefis

src/analysis/locate.ml

@@ -703,8 +703,6 @@ end = struct
 end
 
 let locate ~config ~ml_or_mli ~path ~lazy_trie ~pos ~str_ident loc =
-  File_switching.reset ();
-  Fallback.reset ();
   Preferences.set ml_or_mli;
   log ~title:"locate"
     "present in the environment, walking up the typedtree looking for '%s'"
@@ -740,6 +738,8 @@ let from_longident ~config ~env ~lazy_trie ~pos nss ml_or_mli ident =
       locate ~config ~ml_or_mli ~path:tagged_path ~lazy_trie ~pos ~str_ident loc
 
 let from_path ~config ~env ~local_defs ~pos ~namespace ml_or_mli path =
+  File_switching.reset ();
+  Fallback.reset ();
   let str_ident = Path.name path in
   if Utils.is_builtin_path path then
     `Builtin
@@ -761,6 +761,8 @@ let from_path ~config ~env ~local_defs ~pos ~namespace ml_or_mli path =
       | `Found (loc, _) -> find_source ~config loc str_ident
 
 let from_string ~config ~env ~local_defs ~pos ?namespaces switch path =
+  File_switching.reset ();
+  Fallback.reset ();
   let browse = Mbrowse.of_typedtree local_defs in
   let lazy_trie =
     lazy (Typedtrie.of_browses ~local_buffer:true
@@ -808,6 +810,8 @@ let from_string ~config ~env ~local_defs ~pos ?namespaces switch path =
     | `Found (loc, _) -> find_source ~config loc path
 
 let get_doc ~config ~env ~local_defs ~comments ~pos =
+  File_switching.reset ();
+  Fallback.reset ();
   let browse = Mbrowse.of_typedtree local_defs in
   let lazy_trie = lazy (Typedtrie.of_browses ~local_buffer:true
                           [Browse_tree.of_browse browse]) in

tests/test-dirs/src-documentation.t/dune tests/test-dirs/document/src-documentation.t/dune

@@ -0,0 +1,33 @@
+A test showing that we manage to get docstrings even when they are not kept as
+attributes on the AST.
+
+  $ cat >test.ml <<EOF
+  > let foo x y = (** incorrect doc for foo *)
+  >   x + y
+  >  
+  > let bar = foo
+  > EOF
+
+  $ $MERLIN single document -position 4:13 -filename test.ml < test.ml
+  {
+    "class": "return",
+    "value": "incorrect doc for foo",
+    "notifications": []
+  }
+
+And that it also works outside of the current buffer:
+
+  $ $OCAMLC -c -bin-annot -w +50 test.ml
+  File "test.ml", line 1, characters 14-42:
+  1 | let foo x y = (** incorrect doc for foo *)
+                    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+  Warning 50 [unexpected-docstring]: unattached documentation comment (ignored)
+
+  $ $MERLIN single document -position 1:18 -filename outside.ml << EOF
+  > let bar = Test.foo
+  > EOF
+  {
+    "class": "return",
+    "value": "incorrect doc for foo",
+    "notifications": []
+  }

tests/test-dirs/src-documentation.t/dune-project tests/test-dirs/document/src-documentation.t/dune-project

@@ -0,0 +1,65 @@
+Reproduce [ocaml-lsp #344](https://github.com/ocaml/ocaml-lsp/issues/344): a symbol's
+documentation is some other random documentation from a library that was last pulled for
+completion. See the issue for details. The space is necessary for the position of
+documentation to be fetch-able.
+
+  $ cat >lib_doc.ml <<EOF
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > 
+  > let k = ()
+  > let m = List.map
+  > EOF
+
+we need merlin to keep state between requests, so using server
+
+  $ $MERLIN server stop-server
+
+see that there is no doc for k
+
+  $ $MERLIN server document -position 23:5 < lib_doc.ml | jq '.value'
+  "No documentation available"
+
+we trigger the bug
+
+  $ $MERLIN server document -position 24:15 -filename lib_doc < lib_doc.ml
+  {
+    "class": "return",
+    "value": " [map f [a1; ...; an]] applies function [f] to [a1, ..., an],
+     and builds the list [[f a1; ...; f an]]
+     with the results returned by [f]. Not tail-recursive.
+   ",
+    "notifications": []
+  }
+
+random documentation is fetched for the same `document` request as before
+
+  $ $MERLIN server document -position 23:5 < lib_doc.ml
+  {
+    "class": "return",
+    "value": "No documentation available",
+    "notifications": []
+  }
+
+stop server
+
+  $ $MERLIN server stop-server