From b020dc57545bb58f04a5d369175062f3fe1045d4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 1 Dec 2023 11:00:56 +0100 Subject: [PATCH] uid_of_path can use the decl_id if shapes fail (#1700) from goldfirere/fallback-to-decl_uid --- CHANGES.md | 2 + src/analysis/locate.ml | 86 +++++++++---------- tests/test-dirs/document/issue1513.t | 4 +- tests/test-dirs/locate/local-build-scheme.t | 48 +++++++++++ .../locate/non-local/ignore-kept-locs.t/run.t | 13 +-- 5 files changed, 100 insertions(+), 53 deletions(-) create mode 100644 tests/test-dirs/locate/local-build-scheme.t diff --git a/CHANGES.md b/CHANGES.md index c6b7fad324..77d746f3fd 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,6 +6,8 @@ merlin NEXT_VERSION - Add `--cache-period` flag, that sets cache invalidation period. (#1698) - Ignore the new 5.1 `cmi-file` flag instead of rejecting it (#1710, fixes #1703) + - Fix Merlin locate not fallbacking on the correct file in case of ambiguity + (@goldfirere, #1699) + editor modes - vim: load merlin when Vim is compiled with +python3/dyn (e.g. MacVim) diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index 78ba0e77dd..177bc3c8b5 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -182,7 +182,9 @@ end = struct let reset () = state := None let move_to ~digest file = - log ~title:"File_switching.move_to" "%s" file; + log ~title:"File_switching.move_to" "file: %s\ndigest: %s" file + @@ Digest.to_hex digest; + state := Some { last_file_visited = file ; digest } let where_am_i () = Option.map !state ~f:last_file_visited @@ -359,14 +361,15 @@ let uid_of_path ~config ~env ~ml_or_mli ~decl_uid path namespace = ~namespace:Shape.Sig_component_kind.Module env (Pident id) end) in - match ml_or_mli with - | `MLI -> - let uid = scrape_alias ~fallback_uid:decl_uid ~env ~namespace path in - log ~title:"uid_of_path" "Declaration uid: %a" - Logger.fmt (fun fmt -> Shape.Uid.print fmt decl_uid); - log ~title:"uid_of_path" "Alias scrapped: %a" + let unalias fallback_uid = + let uid = scrape_alias ~fallback_uid ~env ~namespace path in + log ~title:"uid_of_path" "Unaliasing uid: %a -> %a" + Logger.fmt (fun fmt -> Shape.Uid.print fmt fallback_uid) Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); - Some uid + uid + in + match ml_or_mli with + | `MLI -> unalias decl_uid | `ML -> let shape = Env.shape_of_path ~namespace env path in log ~title:"shape_of_path" "initial: %a" @@ -374,7 +377,11 @@ let uid_of_path ~config ~env ~ml_or_mli ~decl_uid path namespace = let r = Shape_reduce.weak_reduce env shape in log ~title:"shape_of_path" "reduced: %a" Logger.fmt (fun fmt -> Shape.print fmt r); - r.uid + match r.uid with + | Some uid -> uid + | None -> + log ~title:"shape_of_path" "No uid found; fallbacking to declaration uid"; + unalias decl_uid let from_uid ~config ~ml_or_mli uid loc path = let loc_of_comp_unit comp_unit = @@ -387,61 +394,48 @@ let from_uid ~config ~ml_or_mli uid loc path = in let title = "from_uid" in match uid with - | Some (Shape.Uid.Item { comp_unit; _ } as uid) -> + | Shape.Uid.Item { comp_unit; _ } -> let locopt = - if Env.get_unit_name () = comp_unit then begin - log ~title "We look for %a in the current compilation unit." + let log_and_return msg = log ~title msg; None in + let uid_to_loc_tbl = + if Env.get_unit_name () = comp_unit then begin + log ~title "We look for %a in the current compilation unit." + Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); + Some (Env.get_uid_to_loc_tbl ()) + end else begin + log ~title "Loading the cmt for unit %S" comp_unit; + match load_cmt ~config comp_unit ml_or_mli with + | Ok (_pos_fname, cmt) -> Some cmt.cmt_uid_to_loc + | Error () -> log_and_return "Failed to load the cmt file." + end + in + Option.bind uid_to_loc_tbl ~f:(fun tbl -> + log ~title "Looking for %a in the uid_to_loc table" Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); - let tbl = Env.get_uid_to_loc_tbl () in match Shape.Uid.Tbl.find_opt tbl uid with | Some loc -> log ~title "Found location: %a" Logger.fmt (fun fmt -> Location.print_loc fmt loc); Some (uid, loc) - | None -> - log ~title - "Uid not found in the local table.\ - Fallbacking to the node's location: %a" - Logger.fmt (fun fmt -> Location.print_loc fmt loc); - Some (uid, loc) - end else begin - log ~title "Loading the shapes for unit %S" comp_unit; - match load_cmt ~config comp_unit ml_or_mli with - | Ok (_pos_fname, cmt) -> - log ~title "Shapes successfully loaded, looking for %a" - Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); - begin match Shape.Uid.Tbl.find_opt cmt.cmt_uid_to_loc uid with - | Some loc -> - log ~title "Found location: %a" - Logger.fmt (fun fmt -> Location.print_loc fmt loc); - Some (uid, loc) - | None -> - log ~title "Uid not found in the cmt table. \ - Fallbacking to the node's location: %a" - Logger.fmt (fun fmt -> Location.print_loc fmt loc); - Some (uid, loc) - end - | _ -> - log ~title "Failed to load the shapes"; - None - end + | None -> log_and_return "Uid not found in the table.") in begin match locopt with | Some (uid, loc) -> `Found (Some uid, loc) - | None -> `Not_found (Path.name path, None) + | None -> + log ~title "Fallbacking to lookup location: %a" + Logger.fmt (fun fmt -> Location.print_loc fmt loc); + `Found (Some uid, loc) end - | Some (Compilation_unit comp_unit as uid) -> + | Compilation_unit comp_unit -> begin log ~title "Got the uid of a compilation unit: %a" Logger.fmt (fun fmt -> Shape.Uid.print fmt uid); match loc_of_comp_unit comp_unit with | Some loc -> `Found (Some uid, loc) - | _ -> log ~title "Failed to load the shapes"; + | _ -> log ~title "Failed to load the CU's cmt"; `Not_found (Path.name path, None) end - | Some (Predef _ | Internal) -> assert false - | None -> log ~title "No UID found, fallbacking to lookup location."; - `Found (None, loc) + | Predef _ | Internal -> assert false let locate ~config ~env ~ml_or_mli decl_uid loc path ns = let uid = uid_of_path ~config ~env ~ml_or_mli ~decl_uid path ns in diff --git a/tests/test-dirs/document/issue1513.t b/tests/test-dirs/document/issue1513.t index b9e18604f9..245bfed984 100644 --- a/tests/test-dirs/document/issue1513.t +++ b/tests/test-dirs/document/issue1513.t @@ -20,8 +20,8 @@ FIXME: We should not rely on "fallbacking". This requires a compiler change. $ $MERLIN single document -position 1:13 \ > -log-file - -log-section locate \ > -filename main.ml &1 | - > grep "Uid not found in the cmt table" - Uid not found in the cmt table. Fallbacking to the node's location: File "naux.ml", line 2, characters 2-5 + > grep "Uid not found in the table." + Uid not found in the table. FIXME: expected "B Comment" $ $MERLIN single document -position 2:13 \ diff --git a/tests/test-dirs/locate/local-build-scheme.t b/tests/test-dirs/locate/local-build-scheme.t new file mode 100644 index 0000000000..eae49fc8fe --- /dev/null +++ b/tests/test-dirs/locate/local-build-scheme.t @@ -0,0 +1,48 @@ + $ mkdir experimental + $ mkdir unix + + $ cat >experimental/m_intf.ml <<'EOF' + > module type S = sig val x : int end (* diff *) + > EOF + + $ cat >experimental/exp.ml <<'EOF' + > module M_intf = M_intf + > EOF + + $ cat >unix/m_intf.ml <<'EOF' + > module type S = sig val x : int end + > EOF + + $ cat >unix/unix.ml <<'EOF' + > module M_intf = M_intf + > EOF + + $ cat >hack.ml <<'EOF' + > let f (module R : Exp.M_intf.S) = + > let _ = R.x in + > () + > EOF + + $ cd experimental + $ $OCAMLC -keep-locs -bin-annot m_intf.ml exp.ml + $ cd .. + + $ cd unix + $ $OCAMLC -keep-locs -bin-annot m_intf.ml unix.ml + $ cd .. + + $ $OCAMLC -keep-locs -bin-annot -I experimental/ -I linux/ hack.ml + + $ $MERLIN single locate -position 2:12 -look-for implementation \ + > -build-path experimental -build-path unix \ + > -source-path . -source-path unix -source-path experimental \ + > -filename hack.ml sed 's/"file": ".*experimental.*"/"file": "experimental"/' | jq '.value' + { + "file": "experimental", + "pos": { + "line": 1, + "col": 20 + } + } + diff --git a/tests/test-dirs/locate/non-local/ignore-kept-locs.t/run.t b/tests/test-dirs/locate/non-local/ignore-kept-locs.t/run.t index 218681b389..3a0fc89d37 100644 --- a/tests/test-dirs/locate/non-local/ignore-kept-locs.t/run.t +++ b/tests/test-dirs/locate/non-local/ignore-kept-locs.t/run.t @@ -20,8 +20,8 @@ available: } $ grep -A1 from_uid log | grep -v from_uid | sed '/^--$/d' - Loading the shapes for unit "A" - Shapes successfully loaded, looking for A.0 + Loading the cmt for unit "A" + Looking for A.0 in the uid_to_loc table Found location: File "a.ml", line 1, characters 4-9 $ rm log @@ -41,8 +41,8 @@ available: } $ grep -A1 from_uid log | grep -v from_uid | sed '/^--$/d' - Loading the shapes for unit "A" - Shapes successfully loaded, looking for A.0 + Loading the cmt for unit "A" + Looking for A.0 in the uid_to_loc table Found location: File "a.ml", line 1, characters 4-9 $ rm log @@ -66,6 +66,9 @@ In the absence of cmt though, fallbacking to the cmi loc makes sense: } $ grep -A1 from_uid log | grep -v from_uid - No UID found, fallbacking to lookup location. + Loading the cmt for unit "A" + -- + Failed to load the cmt file. + Fallbacking to lookup location: File "a.ml", line 1, characters 4-9 $ rm log