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 1/5] 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 From 5ff72bb5a471049223e5aba4e7b0a08d98db1d8f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 1 Dec 2023 11:04:14 +0100 Subject: [PATCH 2/5] Change flag name from `-cache-period` to `-cache-lifespan` (#1705) from 3Rafal/cache-lifespan --- CHANGES.md | 3 ++- doc/dev/CACHING.md | 2 +- emacs/merlin.el | 6 +++--- src/frontend/ocamlmerlin/new/new_merlin.ml | 2 +- src/kernel/mconfig.ml | 10 +++++----- src/kernel/mconfig.mli | 2 +- tests/test-dirs/config/dot-merlin-reader/quoting.t | 2 +- tests/test-dirs/server-tests/cache-time.t | 6 +++--- 8 files changed, 17 insertions(+), 16 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 77d746f3fd..bce01ac25f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -3,7 +3,8 @@ merlin NEXT_VERSION + merlin binary - Fix a follow-up issue to the preference of non-ghost nodes introduced in #1660 (#1690, fixes #1689) - - Add `--cache-period` flag, that sets cache invalidation period. (#1698) + - Add `-cache-lifespan` flag, that sets cache invalidation period. (#1698, + #1705) - 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 diff --git a/doc/dev/CACHING.md b/doc/dev/CACHING.md index c422cb40c0..a272e6633d 100644 --- a/doc/dev/CACHING.md +++ b/doc/dev/CACHING.md @@ -78,7 +78,7 @@ to be used anymore. `Mocaml.flush_caches` remove all files that have changed on disk or that haven't been used for some time. By default, `ocamlmerlin_server` remove entries that haven't been used in the last 5 minutes. This behavior can be -changed with `--cache-period` flag. +changed with `-cache-lifespan` flag. Since this involve stating each entry, the check is done after answering. diff --git a/emacs/merlin.el b/emacs/merlin.el index bc2df647cb..3f79d97481 100644 --- a/emacs/merlin.el +++ b/emacs/merlin.el @@ -194,7 +194,7 @@ a new window or not." "If non-nil, use this file for the log file (should be an absolute path)." :group 'merlin :type 'file) -(defcustom merlin-cache-period nil +(defcustom merlin-cache-lifespan nil "If non-nil, use this value for cache period (measured in minutes)." :group 'merlin :type 'natnum) @@ -554,8 +554,8 @@ argument (lookup appropriate binary, setup logging, pass global settings)" (cons "-flags" merlin-buffer-flags)) (when filename (cons "-filename" filename)) - (when merlin-cache-period - (cons "-cache-period" (number-to-string merlin-cache-period))) + (when merlin-cache-lifespan + (cons "-cache-lifespan" (number-to-string merlin-cache-lifespan))) args)) ;; Log last commands (setq merlin-debug-last-commands diff --git a/src/frontend/ocamlmerlin/new/new_merlin.ml b/src/frontend/ocamlmerlin/new/new_merlin.ml index 213835b0fb..2d6f16808b 100644 --- a/src/frontend/ocamlmerlin/new/new_merlin.ml +++ b/src/frontend/ocamlmerlin/new/new_merlin.ml @@ -92,7 +92,7 @@ let run = function Logger.with_log_file Mconfig.(config.merlin.log_file) ~sections:Mconfig.(config.merlin.log_sections) @@ fun () -> Mocaml.flush_caches - ~older_than:(float_of_int (60 * Mconfig.(config.merlin.cache_period))) (); + ~older_than:(float_of_int (60 * Mconfig.(config.merlin.cache_lifespan))) (); File_id.with_cache @@ fun () -> let source = Msource.make (Misc.string_of_file stdin) in let pipeline = Mpipeline.make config source in diff --git a/src/kernel/mconfig.ml b/src/kernel/mconfig.ml index 4db1c629e6..6861614ec4 100644 --- a/src/kernel/mconfig.ml +++ b/src/kernel/mconfig.ml @@ -92,7 +92,7 @@ type merlin = { failures : string list; extension_to_reader : (string * string) list; - cache_period : int + cache_lifespan : int } let dump_merlin x = @@ -129,7 +129,7 @@ let dump_merlin x = "reader", `String reader; ]) x.extension_to_reader ); - "cache_period" , Json.string (string_of_int x.cache_period) + "cache_lifespan" , Json.string (string_of_int x.cache_lifespan) ] module Verbosity = struct @@ -359,9 +359,9 @@ let merlin_flags = [ " Change path of ocaml standard library" ); ( - "-cache-period", + "-cache-lifespan", Marg.param "int" (fun prot merlin -> - try {merlin with cache_period = (int_of_string prot)} + try {merlin with cache_lifespan = (int_of_string prot)} with _ -> invalid_arg "Valid value is int"; ), "Change file cache retention period. It's measured in minutes. \ @@ -626,7 +626,7 @@ let initial = { failures = []; extension_to_reader = [(".re","reason");(".rei","reason")]; - cache_period = 5; + cache_lifespan = 5; }; query = { filename = "*buffer*"; diff --git a/src/kernel/mconfig.mli b/src/kernel/mconfig.mli index 998dc3110f..b70847b302 100644 --- a/src/kernel/mconfig.mli +++ b/src/kernel/mconfig.mli @@ -49,7 +49,7 @@ type merlin = { failures : string list; extension_to_reader : (string * string) list; - cache_period : int + cache_lifespan : int } val dump_merlin : merlin -> json diff --git a/tests/test-dirs/config/dot-merlin-reader/quoting.t b/tests/test-dirs/config/dot-merlin-reader/quoting.t index c420427db7..b9ae8c7eee 100644 --- a/tests/test-dirs/config/dot-merlin-reader/quoting.t +++ b/tests/test-dirs/config/dot-merlin-reader/quoting.t @@ -67,7 +67,7 @@ "reader": "reason" } ], - "cache_period": "5" + "cache_lifespan": "5" } $ rm .merlin diff --git a/tests/test-dirs/server-tests/cache-time.t b/tests/test-dirs/server-tests/cache-time.t index 0069d3e3dd..010b8373d7 100644 --- a/tests/test-dirs/server-tests/cache-time.t +++ b/tests/test-dirs/server-tests/cache-time.t @@ -16,18 +16,18 @@ > EOF Let's populate file cache - $ $MERLIN server errors -log-file merlin_logs -cache-period 45 \ + $ $MERLIN server errors -log-file merlin_logs -cache-lifespan 45 \ > -filename main.ml 1> /dev/null -filename main.ml 1> /dev/null | tail -1 | sed 's/\ ".*\"//' keeping When cache time is set to 0, file cache gets flushed - $ $MERLIN server errors -log-file merlin_logs -cache-period 0 \ + $ $MERLIN server errors -log-file merlin_logs -cache-lifespan 0 \ > -filename main.ml 1> /dev/null | tail -1 | sed 's/\ ".*\"//' From 10b3377c0f4dea16c356fb90c306578794871f86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 1 Dec 2023 11:06:48 +0100 Subject: [PATCH 3/5] Fixed Merlin recovery causing incorrect error messages (#1709) from voodoos/issue1704-bad-error-messages --- CHANGES.md | 2 + src/ocaml/typing/typedecl.ml | 4 +- src/ocaml/typing/typetexp.ml | 4 +- .../errors/issue1704-wrong-message.t | 59 +++++++++++++++++++ 4 files changed, 67 insertions(+), 2 deletions(-) create mode 100644 tests/test-dirs/errors/issue1704-wrong-message.t diff --git a/CHANGES.md b/CHANGES.md index bce01ac25f..ff78cbf791 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,6 +9,8 @@ merlin NEXT_VERSION #1703) - Fix Merlin locate not fallbacking on the correct file in case of ambiguity (@goldfirere, #1699) + - Fix Merlin reporting errors provoked by the recovery itself (#1709, fixes + #1704) + editor modes - vim: load merlin when Vim is compiled with +python3/dyn (e.g. MacVim) diff --git a/src/ocaml/typing/typedecl.ml b/src/ocaml/typing/typedecl.ml index 3aebf084d6..e01e80e5f4 100644 --- a/src/ocaml/typing/typedecl.ml +++ b/src/ocaml/typing/typedecl.ml @@ -1154,7 +1154,9 @@ let transl_type_decl env rec_flag sdecl_list = (fun sdecl tdecl -> let decl = tdecl.typ_type in match Ctype.closed_type_decl decl with - Some ty -> raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl))) + Some ty -> + if not (Msupport.erroneous_type_check ty) then + raise(Error(sdecl.ptype_loc, Unbound_type_var(ty,decl))) | None -> ()) sdecl_list tdecls; (* Check that constraints are enforced *) diff --git a/src/ocaml/typing/typetexp.ml b/src/ocaml/typing/typetexp.ml index 9477f94cfc..a104ba8d57 100644 --- a/src/ocaml/typing/typetexp.ml +++ b/src/ocaml/typing/typetexp.ml @@ -416,9 +416,11 @@ let rec transl_type env ~policy ?(aliased=false) ~row_context styp = try transl_type_aux env ~policy ~aliased ~row_context styp with exn -> + let ty = new_global_var () in + Msupport.erroneous_type_register ty; Msupport.raise_error exn; { ctyp_desc = Ttyp_any; - ctyp_type = new_global_var (); + ctyp_type = ty; ctyp_env = env; ctyp_loc = styp.ptyp_loc; ctyp_attributes = []; diff --git a/tests/test-dirs/errors/issue1704-wrong-message.t b/tests/test-dirs/errors/issue1704-wrong-message.t new file mode 100644 index 0000000000..b6e7faa11d --- /dev/null +++ b/tests/test-dirs/errors/issue1704-wrong-message.t @@ -0,0 +1,59 @@ + $ cat >test.ml <<'EOF' + > type foo = { + > bar: X.t; + > } + > type foo2 = X.t + > type foo3 = bar + > EOF + +Merlin should not report unbound variable errors in that case since it is +due to it's own type recovery. + $ $MERLIN single errors -filename test.ml Date: Fri, 1 Dec 2023 11:09:17 +0100 Subject: [PATCH 4/5] Emacs: Highlight only first error line by default (#1693) from 3Rafal/highlight-first-error-line-only --- CHANGES.md | 1 + emacs/merlin.el | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index ff78cbf791..93d14237b2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -13,6 +13,7 @@ merlin NEXT_VERSION #1704) + editor modes - vim: load merlin when Vim is compiled with +python3/dyn (e.g. MacVim) + - emacs: highlight only first error line by default (#1693, fixes #1663) merlin 4.12 =========== diff --git a/emacs/merlin.el b/emacs/merlin.el index 3f79d97481..9100dfa360 100644 --- a/emacs/merlin.el +++ b/emacs/merlin.el @@ -153,7 +153,7 @@ If a string list, check only if the extension of the buffer-file-name "If non-nil, display errors in fringe" :group 'merlin :type 'boolean) -(defcustom merlin-error-on-single-line nil +(defcustom merlin-error-on-single-line t "Only highlight first line of multi-line error messages" :group 'merlin :type 'boolean) From 6a770249bf4ca3296289dc4f60a40416a59232b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 1 Dec 2023 14:40:28 +0100 Subject: [PATCH 5/5] Prepare for release 4.13-501 --- CHANGES.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 93d14237b2..aba627c99c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,6 @@ -merlin NEXT_VERSION -=================== +merlin 4.13 +=========== +Fri Dec 1 15:00:42 CET 2023 + merlin binary - Fix a follow-up issue to the preference of non-ghost nodes introduced in #1660 (#1690, fixes #1689)