From 648e6ff2e53cd9c5ea9d7eed73def24d3dd24f5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 26 Mar 2025 18:16:16 +0100 Subject: [PATCH 01/53] Add more module test cases for renaming --- .../for-renaming/r-modules-and-types.t | 95 +++++++++++++++++-- 1 file changed, 88 insertions(+), 7 deletions(-) diff --git a/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t b/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t index 8f84dfc978..9365daacec 100644 --- a/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t +++ b/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t @@ -8,34 +8,46 @@ > module type S = sig > val x : unit > end + > let () = + > let module X : S = struct let x = () end in + > X.x > EOF $ cat >main.ml <<'EOF' > module M : Lib.S = struct > let x = () > end - > let () = M.x + > module N = M + > let () = let open M in N.x > EOF $ ocamlc -bin-annot -bin-annot-occurrences -c lib.mli lib.ml main.ml $ ocaml-index aggregate *.cmti *.cmt $ ocaml-index dump project.ocaml-index - 6 uids: + 8 uids: {uid: [intf]Lib.0; locs: "x": File "lib.mli", line 2, characters 6-7 uid: Lib.0; locs: "x": File "lib.ml", line 2, characters 6-7 uid: [intf]Lib.1; locs: "S": File "lib.mli", line 1, characters 12-13 uid: Lib.1; locs: "S": File "lib.ml", line 1, characters 12-13; + "S": File "lib.ml", line 5, characters 17-18; "Lib.S": File "main.ml", line 1, characters 11-16 + uid: Lib.2; locs: + "x": File "lib.ml", line 5, characters 32-33; + "X.x": File "lib.ml", line 6, characters 2-5 uid: Main.0; locs: "x": File "main.ml", line 2, characters 6-7; - "M.x": File "main.ml", line 4, characters 9-12 - uid: Main.1; locs: "M": File "main.ml", line 1, characters 7-8 }, + "N.x": File "main.ml", line 5, characters 23-26 + uid: Main.1; locs: + "M": File "main.ml", line 1, characters 7-8; + "M": File "main.ml", line 4, characters 11-12; + "M": File "main.ml", line 5, characters 18-19 + uid: Main.2; locs: "N": File "main.ml", line 4, characters 7-8 }, 0 approx shapes: {}, and shapes for CUS . - and related uids:{([intf]Lib.1 Lib.1); ([intf]Lib.0 Lib.0 Main.0)} + and related uids:{([intf]Lib.1 Lib.1); ([intf]Lib.0 Lib.0 Lib.2 Main.0)} - $ $MERLIN single occurrences -scope renaming -identifier-at 4:11 \ + $ $MERLIN single occurrences -scope renaming -identifier-at 5:25 \ > -index-file project.ocaml-index \ > -filename main.ml -index-file project.ocaml-index \ + > -filename main.ml Date: Wed, 9 Apr 2025 16:53:13 +0200 Subject: [PATCH 02/53] Make `inlay-hints` triggerable for function params --- src/analysis/inlay_hints.ml | 39 +++++------ src/analysis/inlay_hints.mli | 1 + src/commands/new_commands.ml | 115 +++++++++++++++++++++++++++++---- src/commands/query_json.ml | 9 ++- src/frontend/query_commands.ml | 10 ++- src/frontend/query_protocol.ml | 2 +- 6 files changed, 139 insertions(+), 37 deletions(-) diff --git a/src/analysis/inlay_hints.ml b/src/analysis/inlay_hints.ml index 54de9cda65..f9c9c1c4e6 100644 --- a/src/analysis/inlay_hints.ml +++ b/src/analysis/inlay_hints.ml @@ -17,7 +17,7 @@ let pattern_has_constraint (type a) (pattern : a Typedtree.general_pattern) = pattern.pat_extra let structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location typedtree range callback = + hint_function_params avoid_ghost_location typedtree range callback = let case_iterator hint_lhs (iterator : Iterator.iterator) case = let () = log ~title:"case" "on case" in let () = if hint_lhs then iterator.pat iterator case.Typedtree.c_lhs in @@ -63,20 +63,18 @@ let structure_iterator hint_let_binding hint_pattern_binding let () = log ~title:"expression" "on match" in let () = iterator.expr iterator expr in List.iter ~f:(case_iterator hint_pattern_binding iterator) cases - | Texp_function - ( _, - Tfunction_cases - { cases = - [ { c_rhs = - { exp_desc = Texp_let (_, [ { vb_pat; _ } ], body); _ }; - _ - } - ]; - _ - } ) -> + | Texp_function (args, body) -> ( let () = log ~title:"expression" "on function" in - let () = iterator.pat iterator vb_pat in - iterator.expr iterator body + if hint_function_params then + List.iter args ~f:(fun Typedtree.{ fp_kind; _ } -> + match fp_kind with + | Tparam_pat pat | Tparam_optional_default (pat, _) -> + iterator.pat iterator pat); + match body with + | Tfunction_cases { cases; _ } -> + List.iter cases ~f:(fun case -> + case_iterator hint_pattern_binding iterator case) + | Tfunction_body body -> iterator.expr iterator body) | _ when is_ghost_location avoid_ghost_location expr.exp_loc -> (* Stop iterating when we see a ghost location to avoid annotating generated code *) @@ -138,21 +136,24 @@ let create_hint env typ loc = let position = loc.Location.loc_end in (position, label) -let of_structure ~hint_let_binding ~hint_pattern_binding ~avoid_ghost_location - ~start ~stop structure = +let of_structure ~hint_let_binding ~hint_pattern_binding ~hint_function_params + ~avoid_ghost_location ~start ~stop structure = let () = log ~title:"start" "%a" Logger.fmt (fun fmt -> Format.fprintf fmt - "Start on %s to %s with : let: %b, pat: %b, ghost: %b" + "Start on %s to %s with : let: %b, pat: %b, function_param: %b, \ + ghost: %b" (Lexing.print_position () start) (Lexing.print_position () stop) - hint_let_binding hint_pattern_binding avoid_ghost_location) + hint_let_binding hint_pattern_binding hint_function_params + avoid_ghost_location) in let range = (start, stop) in let hints = ref [] in let () = structure_iterator hint_let_binding hint_pattern_binding - avoid_ghost_location structure range (fun env typ loc -> + hint_function_params avoid_ghost_location structure range + (fun env typ loc -> let () = log ~title:"hint" "Find hint %a" Logger.fmt (fun fmt -> Format.fprintf fmt "%s - %a" diff --git a/src/analysis/inlay_hints.mli b/src/analysis/inlay_hints.mli index 575f8b7778..632b6d208e 100644 --- a/src/analysis/inlay_hints.mli +++ b/src/analysis/inlay_hints.mli @@ -5,6 +5,7 @@ type hint = Lexing.position * string val of_structure : hint_let_binding:bool -> hint_pattern_binding:bool -> + hint_function_params:bool -> avoid_ghost_location:bool -> start:Lexing.position -> stop:Lexing.position -> diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml index 9159d1b31e..5745c45334 100644 --- a/src/commands/new_commands.ml +++ b/src/commands/new_commands.ml @@ -685,37 +685,121 @@ let all_commands = ~spec: [ arg "-start" " Where inlay-hints generation start" (marg_position - (fun start (_start, stop, let_binding, pattern_binding, ghost) -> - (start, stop, let_binding, pattern_binding, ghost))); + (fun + start + ( _start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); arg "-end" " Where inlay-hints generation stop" (marg_position - (fun stop (start, _stop, let_binding, pattern_binding, ghost) -> - (start, stop, let_binding, pattern_binding, ghost))); + (fun + stop + ( start, + _stop, + let_binding, + pattern_binding, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); optional "-let-binding" " Hint let-binding (default is false)" (Marg.bool (fun let_binding - (start, stop, _let_binding, pattern_binding, ghost) - -> (start, stop, let_binding, pattern_binding, ghost))); + ( start, + stop, + _let_binding, + pattern_binding, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); optional "-pattern-binding" " Hint pattern-binding (default is false)" (Marg.bool (fun pattern_binding - (start, stop, let_binding, _pattern_binding, ghost) - -> (start, stop, let_binding, pattern_binding, ghost))); + ( start, + stop, + let_binding, + _pattern_binding, + function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); + optional "-function-params" + " Hint function parameters (default is false)" + (Marg.bool + (fun + function_params + ( start, + stop, + let_binding, + pattern_binding, + _function_params, + ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))); optional "-avoid-ghost-location" " Avoid hinting ghost location (default is true)" (Marg.bool - (fun ghost (start, stop, let_binding, pattern_binding, _ghost) -> - (start, stop, let_binding, pattern_binding, ghost))) + (fun + ghost + ( start, + stop, + let_binding, + pattern_binding, + function_params, + _ghost ) + -> + ( start, + stop, + let_binding, + pattern_binding, + function_params, + ghost ))) ] - ~default:(`None, `None, false, false, true) + ~default:(`None, `None, false, false, false, true) begin fun shared config source - (start, stop, let_binding, pattern_binding, avoid_ghost) + ( start, + stop, + let_binding, + pattern_binding, + function_params, + avoid_ghost ) -> match (start, stop) with | `None, `None -> failwith "-start and -end are mandatory" @@ -726,7 +810,12 @@ let all_commands = let position = Msource.get_position source stop in run ~position shared config source (Query_protocol.Inlay_hints - (start, stop, let_binding, pattern_binding, avoid_ghost)) + ( start, + stop, + let_binding, + pattern_binding, + function_params, + avoid_ghost )) end; command "shape" ~doc: diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index 4ded2cf581..69e2e336f5 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -134,12 +134,19 @@ let dump (type a) : a t -> json = | Some `Local -> `String "local" ); ("depth", `Int depth) ] - | Inlay_hints (start, stop, hint_let_binding, hint_pattern_var, ghost) -> + | Inlay_hints + ( start, + stop, + hint_let_binding, + hint_pattern_var, + hint_function_params, + ghost ) -> mk "inlay-hints" [ ("start", mk_position start); ("stop", mk_position stop); ("hint-let-binding", `Bool hint_let_binding); ("hint-pattern-variable", `Bool hint_pattern_var); + ("hint-function-params", `Bool hint_function_params); ("avoid-ghost-location", `Bool ghost) ] | Outline -> mk "outline" [] diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index 27deeae8e3..b5376800be 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -803,8 +803,12 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function in (occurrences, status) | Inlay_hints - (start, stop, hint_let_binding, hint_pattern_binding, avoid_ghost_location) - -> + ( start, + stop, + hint_let_binding, + hint_pattern_binding, + hint_function_params, + avoid_ghost_location ) -> let start = Mpipeline.get_lexing_pos pipeline start and stop = Mpipeline.get_lexing_pos pipeline stop in let typer_result = Mpipeline.typer_result pipeline in @@ -813,7 +817,7 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = function | `Interface _ -> [] | `Implementation structure -> Inlay_hints.of_structure ~hint_let_binding ~hint_pattern_binding - ~avoid_ghost_location ~start ~stop structure + ~hint_function_params ~avoid_ghost_location ~start ~stop structure end | Signature_help { position; _ } -> ( (* Todo: additionnal contextual information could help us provide better diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index 0c867ca1f0..4c9e9ffaea 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -202,7 +202,7 @@ type _ t = Msource.position * [ `None | `Local ] option * int option -> (Location.t * string list) t | Inlay_hints : - Msource.position * Msource.position * bool * bool * bool + Msource.position * Msource.position * bool * bool * bool * bool -> (Lexing.position * string) list t | Outline (* *) : outline t | Shape (* *) : Msource.position -> shape list t From 884d8523f63c0849e2f4b5bf3aefccc44c0e9257 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 16:53:36 +0200 Subject: [PATCH 03/53] Test cases for `inlay-hints` on function params --- tests/test-dirs/inlay-hint/samples.t | 89 +++++++++++++++++++++++++++- 1 file changed, 88 insertions(+), 1 deletion(-) diff --git a/tests/test-dirs/inlay-hint/samples.t b/tests/test-dirs/inlay-hint/samples.t index de3be2b4ba..ee3eed780f 100644 --- a/tests/test-dirs/inlay-hint/samples.t +++ b/tests/test-dirs/inlay-hint/samples.t @@ -1,6 +1,77 @@ +Regular function + + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ + > -filename inlay.ml < let f a b c d e f = (a + b, c ^ d, e +. (float_of_string f)) + > EOF + { + "class": "return", + "value": [ + { + "pos": { + "line": 1, + "col": 17 + }, + "label": "string" + }, + { + "pos": { + "line": 1, + "col": 15 + }, + "label": "float" + }, + { + "pos": { + "line": 1, + "col": 13 + }, + "label": "string" + }, + { + "pos": { + "line": 1, + "col": 11 + }, + "label": "string" + }, + { + "pos": { + "line": 1, + "col": 9 + }, + "label": "int" + }, + { + "pos": { + "line": 1, + "col": 7 + }, + "label": "int" + } + ], + "notifications": [] + } + +Regular function without function-params + + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params false \ + > -filename inlay.ml < let f a b c d e f = (a + b, c ^ d, e +. (float_of_string f)) + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + + Optional argument $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f ?x () = x () > EOF @@ -18,9 +89,22 @@ Optional argument "notifications": [] } +Optional argument without function-params + + $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -filename inlay.ml < let f ?x () = x () + > EOF + { + "class": "return", + "value": [], + "notifications": [] + } + Optional argument with value $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f ?(x = 1) () = x > EOF @@ -41,6 +125,7 @@ Optional argument with value Labeled argument $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f ~x = x + 1 > EOF @@ -61,6 +146,7 @@ Labeled argument Case argument $ $MERLIN single inlay-hints -start 1:0 -end 2:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f (Some x) = x + 1 > EOF @@ -81,6 +167,7 @@ Case argument Pattern variables without pattern-binding hint $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ + > -function-params true \ > -filename inlay.ml < let f x = > match x with @@ -104,7 +191,7 @@ Pattern variables without pattern-binding hint Pattern variables with pattern-binding hint $ $MERLIN single inlay-hints -start 1:0 -end 4:26 -avoid-ghost-location false \ - > -pattern-binding true \ + > -pattern-binding true -function-params true \ > -filename inlay.ml < let f x = > match x with From 8dc8dfba9e33383a9776d1c1ed896a04907aead9 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 16:56:51 +0200 Subject: [PATCH 04/53] Add CHANGES entry --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index cde92d2fa9..f2a7238c86 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ unreleased - `locate` can now disambiguate between files with identical names and contents (#1882) - `occurrences` now reports stale files (#1885) + - `inlay-hints` fix inlay hints on function parameters (#1923) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From d4bbd32ce49b494762bb7c6d1557d3cf8c9a5f22 Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 9 Apr 2025 19:44:47 +0200 Subject: [PATCH 05/53] Fix test since `dune` release --- tests/test-dirs/issue1900.t/run.t | 35 +++++++++---------------------- 1 file changed, 10 insertions(+), 25 deletions(-) diff --git a/tests/test-dirs/issue1900.t/run.t b/tests/test-dirs/issue1900.t/run.t index ea0c643f77..e4575479e1 100644 --- a/tests/test-dirs/issue1900.t/run.t +++ b/tests/test-dirs/issue1900.t/run.t @@ -1,36 +1,14 @@ $ dune exec ./main.exe test -FIXME: There should be no error. +There should be no error. $ $MERLIN single errors -filename main.ml jq '.value.merlin.flags_applied' [ - { - "workdir": "$TESTCASE_ROOT", - "workval": [ - "-open", - "Dune__exe" - ] - }, { "workdir": "$TESTCASE_ROOT", "workval": [ @@ -44,6 +22,13 @@ FIXME: Dune should communicate the -open Dune__exe flag after the others. "Lib", "-g" ] + }, + { + "workdir": "$TESTCASE_ROOT", + "workval": [ + "-open", + "Dune__exe" + ] } ] From b4bb6ce9252f7279c29a10d7efc80e8953c77990 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 15 Apr 2025 17:36:49 -0400 Subject: [PATCH 06/53] Fix issue with ident filtering --- src/analysis/locate.ml | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index 3ce56b3b67..51967b5f45 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -620,14 +620,16 @@ let find_loc_of_comp_unit ~config uid comp_unit = log ~title "Failed to load the CU's cmt"; `None -let find_loc_of_uid ~config ~local_defs ~ident ?fallback (uid : Shape.Uid.t) = +let find_loc_of_uid ~config ~local_defs ?ident ?fallback (uid : Shape.Uid.t) = let find_loc_of_item ~comp_unit = - match (find_loc_of_item ~config ~local_defs uid comp_unit, fallback) with - | Some { loc; txt }, _ when String.equal txt ident -> + match find_loc_of_item ~config ~local_defs uid comp_unit, fallback, ident with + | Some { loc; txt }, _, Some ident when String.equal txt ident -> (* Checking the ident prevent returning nonsensical results when some uid were swaped but the cmt files were not rebuilt. *) Some (uid, loc) - | (Some _ | None), Some fallback -> + | Some { loc; _ }, _, None -> + Some (uid, loc) + | (Some _ | None), Some fallback, _ -> find_loc_of_item ~config ~local_defs fallback comp_unit |> Option.map ~f:(fun { Location.loc; _ } -> (fallback, loc)) | _ -> None @@ -705,7 +707,7 @@ let rec uid_of_result ~traverse_aliases = function | Approximated _ | Unresolved _ | Internal_error_missing_uid -> (None, true) (** This is the main function here *) -let from_path ~config ~env ~local_defs ~decl path = +let from_path ~config ~env ~local_defs ~decl ?ident:_ path = let title = "from_path" in let unalias (decl : Env_lookup.item) = if not config.traverse_aliases then (path, decl.uid) @@ -752,11 +754,14 @@ let from_path ~config ~env ~local_defs ~decl path = in (* Step 2: Uid => Location *) let loc = - let ident = Path.last path in + let ident = + (* TODO it might not be useful to check the ident without impl_uid *) + Path.last path + in match impl_uid with | Some impl_uid -> find_loc_of_uid ~config ~local_defs ~ident ~fallback:uid impl_uid - | None -> find_loc_of_uid ~config ~local_defs ~ident uid + | None -> find_loc_of_uid ~config ~local_defs uid in let loc = match loc with @@ -792,7 +797,9 @@ let from_longident ~config ~env ~local_defs nss ident = in match Env_lookup.by_longident nss ident env with | None -> `Not_in_env str_ident - | Some (path, decl) -> from_path ~config ~env ~local_defs ~decl path + | Some (path, decl) -> + let ident = Longident.last ident in + from_path ~config ~env ~local_defs ~decl ~ident path let from_path ~config ~env ~local_defs ~namespace path = File_switching.reset (); From 12e928de5c4c48a15f7bb0f90a29644a73f39154 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 16 Apr 2025 15:47:25 -0400 Subject: [PATCH 07/53] Fix Lid comparison --- src/index-format/lid.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/index-format/lid.ml b/src/index-format/lid.ml index a21da307b4..91bfafe351 100644 --- a/src/index-format/lid.ml +++ b/src/index-format/lid.ml @@ -39,9 +39,7 @@ let pp fmt t = let compare_pos p1 p2 = Int.compare p1.cnum p2.cnum let compare_filename t1 t2 = - String.compare - (Filename.basename (G.fetch t1.filename)) - (Filename.basename (G.fetch t2.filename)) + String.compare (G.fetch t1.filename) (G.fetch t2.filename) let compare t1 t2 = match compare_filename t1 t2 with From f1195c10314d767f1997cbc01e15e6cffdefef56 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 16 Apr 2025 15:53:22 -0400 Subject: [PATCH 08/53] Add a changelog entry --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index f2a7238c86..88e294e377 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,7 @@ unreleased (#1882) - `occurrences` now reports stale files (#1885) - `inlay-hints` fix inlay hints on function parameters (#1923) + - Fix issues with ident validation and Lid comparison for occurrences (#1924) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From 4dc55096b7859a9290b2c7f3a82399f94932b1ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 16 Apr 2025 16:42:29 -0400 Subject: [PATCH 09/53] Promote ordering changes in tests --- .../for-renaming/r-modules-and-types.t | 24 +++++----- .../for-renaming/r-with-functors.t/run.t | 10 ++-- .../occurrences/project-wide/mli-vs-ml.t | 40 ++++++++-------- .../occurrences/project-wide/prefix.t/run.t | 48 +++++++++---------- .../occurrences/project-wide/pwo-basic.t | 24 +++++----- .../project-wide/pwo-canonicalize.t | 20 ++++---- .../occurrences/project-wide/pwo-ml-gen.t | 2 +- .../occurrences/project-wide/stale-index.t | 24 +++++----- 8 files changed, 96 insertions(+), 96 deletions(-) diff --git a/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t b/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t index 9365daacec..7c23e048f3 100644 --- a/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t +++ b/tests/test-dirs/occurrences/project-wide/for-renaming/r-modules-and-types.t @@ -65,6 +65,18 @@ }, "stale": false }, + { + "file": "$TESTCASE_ROOT/main.ml", + "start": { + "line": 5, + "col": 25 + }, + "end": { + "line": 5, + "col": 26 + }, + "stale": false + }, { "file": "$TESTCASE_ROOT/lib.ml", "start": { @@ -112,18 +124,6 @@ "col": 7 }, "stale": false - }, - { - "file": "$TESTCASE_ROOT/main.ml", - "start": { - "line": 5, - "col": 25 - }, - "end": { - "line": 5, - "col": 26 - }, - "stale": false } ], "notifications": [] diff --git a/tests/test-dirs/occurrences/project-wide/for-renaming/r-with-functors.t/run.t b/tests/test-dirs/occurrences/project-wide/for-renaming/r-with-functors.t/run.t index d28346bf3b..dee8c73d25 100644 --- a/tests/test-dirs/occurrences/project-wide/for-renaming/r-with-functors.t/run.t +++ b/tests/test-dirs/occurrences/project-wide/for-renaming/r-with-functors.t/run.t @@ -12,6 +12,11 @@ We expect 2 occurrences in func.ml, 1 in func.mli and 2 in main.ml "line": 1, "col": 22 } + "$TESTCASE_ROOT/main.ml" + { + "line": 4, + "col": 16 + } "$TESTCASE_ROOT/func.ml" { "line": 1, @@ -27,8 +32,3 @@ We expect 2 occurrences in func.ml, 1 in func.mli and 2 in main.ml "line": 1, "col": 24 } - "$TESTCASE_ROOT/main.ml" - { - "line": 4, - "col": 16 - } diff --git a/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t b/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t index 058a905548..f6d3fe52e2 100644 --- a/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t +++ b/tests/test-dirs/occurrences/project-wide/mli-vs-ml.t @@ -48,37 +48,37 @@ the interface and the implementation. "stale": false }, { - "file": "$TESTCASE_ROOT/main.ml", + "file": "$TESTCASE_ROOT/main.mli", "start": { "line": 2, - "col": 5 + "col": 8 }, "end": { "line": 2, - "col": 6 + "col": 9 }, "stale": false }, { "file": "$TESTCASE_ROOT/main.ml", "start": { - "line": 3, - "col": 8 + "line": 2, + "col": 5 }, "end": { - "line": 3, - "col": 9 + "line": 2, + "col": 6 }, "stale": false }, { - "file": "$TESTCASE_ROOT/main.mli", + "file": "$TESTCASE_ROOT/main.ml", "start": { - "line": 2, + "line": 3, "col": 8 }, "end": { - "line": 2, + "line": 3, "col": 9 }, "stale": false @@ -107,37 +107,37 @@ Same when the cursor is at the origin: "stale": false }, { - "file": "$TESTCASE_ROOT/main.ml", + "file": "$TESTCASE_ROOT/main.mli", "start": { "line": 2, - "col": 5 + "col": 8 }, "end": { "line": 2, - "col": 6 + "col": 9 }, "stale": false }, { "file": "$TESTCASE_ROOT/main.ml", "start": { - "line": 3, - "col": 8 + "line": 2, + "col": 5 }, "end": { - "line": 3, - "col": 9 + "line": 2, + "col": 6 }, "stale": false }, { - "file": "$TESTCASE_ROOT/main.mli", + "file": "$TESTCASE_ROOT/main.ml", "start": { - "line": 2, + "line": 3, "col": 8 }, "end": { - "line": 2, + "line": 3, "col": 9 }, "stale": false diff --git a/tests/test-dirs/occurrences/project-wide/prefix.t/run.t b/tests/test-dirs/occurrences/project-wide/prefix.t/run.t index a01b2988c9..138fd05477 100644 --- a/tests/test-dirs/occurrences/project-wide/prefix.t/run.t +++ b/tests/test-dirs/occurrences/project-wide/prefix.t/run.t @@ -99,38 +99,38 @@ Merlin successfully finds occurrences outside file when UNIT_NAME directive is u "stale": false }, { - "file": "$TESTCASE_ROOT/a.ml", + "file": "$TESTCASE_ROOT/b.ml", "start": { - "line": 1, - "col": 12 + "line": 2, + "col": 8 }, "end": { - "line": 1, - "col": 13 + "line": 2, + "col": 9 }, "stale": false }, { "file": "$TESTCASE_ROOT/a.ml", "start": { - "line": 2, - "col": 18 + "line": 1, + "col": 12 }, "end": { - "line": 2, - "col": 19 + "line": 1, + "col": 13 }, "stale": false }, { - "file": "$TESTCASE_ROOT/b.ml", + "file": "$TESTCASE_ROOT/a.ml", "start": { "line": 2, - "col": 8 + "col": 18 }, "end": { "line": 2, - "col": 9 + "col": 19 }, "stale": false } @@ -162,38 +162,38 @@ Merlin successfully finds occurrences outside file when WRAPPING_PREFIX directiv "stale": false }, { - "file": "$TESTCASE_ROOT/a.ml", + "file": "$TESTCASE_ROOT/b.ml", "start": { - "line": 1, - "col": 12 + "line": 2, + "col": 8 }, "end": { - "line": 1, - "col": 13 + "line": 2, + "col": 9 }, "stale": false }, { "file": "$TESTCASE_ROOT/a.ml", "start": { - "line": 2, - "col": 18 + "line": 1, + "col": 12 }, "end": { - "line": 2, - "col": 19 + "line": 1, + "col": 13 }, "stale": false }, { - "file": "$TESTCASE_ROOT/b.ml", + "file": "$TESTCASE_ROOT/a.ml", "start": { "line": 2, - "col": 8 + "col": 18 }, "end": { "line": 2, - "col": 9 + "col": 19 }, "stale": false } diff --git a/tests/test-dirs/occurrences/project-wide/pwo-basic.t b/tests/test-dirs/occurrences/project-wide/pwo-basic.t index f0d234181f..3b58a1c65f 100644 --- a/tests/test-dirs/occurrences/project-wide/pwo-basic.t +++ b/tests/test-dirs/occurrences/project-wide/pwo-basic.t @@ -29,38 +29,38 @@ "class": "return", "value": [ { - "file": "$TESTCASE_ROOT/lib.ml", + "file": "$TESTCASE_ROOT/main.ml", "start": { "line": 1, - "col": 4 + "col": 26 }, "end": { "line": 1, - "col": 7 + "col": 29 }, "stale": false }, { "file": "$TESTCASE_ROOT/lib.ml", "start": { - "line": 2, - "col": 22 + "line": 1, + "col": 4 }, "end": { - "line": 2, - "col": 25 + "line": 1, + "col": 7 }, "stale": false }, { - "file": "$TESTCASE_ROOT/main.ml", + "file": "$TESTCASE_ROOT/lib.ml", "start": { - "line": 1, - "col": 26 + "line": 2, + "col": 22 }, "end": { - "line": 1, - "col": 29 + "line": 2, + "col": 25 }, "stale": false } diff --git a/tests/test-dirs/occurrences/project-wide/pwo-canonicalize.t b/tests/test-dirs/occurrences/project-wide/pwo-canonicalize.t index 3684710fd6..cd7ee00804 100644 --- a/tests/test-dirs/occurrences/project-wide/pwo-canonicalize.t +++ b/tests/test-dirs/occurrences/project-wide/pwo-canonicalize.t @@ -31,26 +31,26 @@ "stale": false }, { - "file": "$TESTCASE_ROOT/lib.ml", + "file": "$TESTCASE_ROOT/main.ml", "start": { - "line": 2, - "col": 22 + "line": 1, + "col": 26 }, "end": { - "line": 2, - "col": 25 + "line": 1, + "col": 29 }, "stale": false }, { - "file": "$TESTCASE_ROOT/main.ml", + "file": "$TESTCASE_ROOT/lib.ml", "start": { - "line": 1, - "col": 26 + "line": 2, + "col": 22 }, "end": { - "line": 1, - "col": 29 + "line": 2, + "col": 25 }, "stale": false } diff --git a/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t b/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t index b1c7a824e4..2b81b77096 100644 --- a/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t +++ b/tests/test-dirs/occurrences/project-wide/pwo-ml-gen.t @@ -57,6 +57,6 @@ We should not index generated modules (lib.ml-gen) $ $MERLIN single occurrences -scope project -identifier-at 3:23 \ > -filename main.ml -index-file project.ocaml-index \ > -filename main.ml < main.ml | jq .value [ - { - "file": "$TESTCASE_ROOT/lib.ml", - "start": { - "line": 2, - "col": 4 - }, - "end": { - "line": 2, - "col": 7 - }, - "stale": true - }, { "file": "$TESTCASE_ROOT/main.ml", "start": { @@ -43,5 +31,17 @@ Foo was defined on line 2 when the index was built, but is now defined on line 1 "col": 29 }, "stale": false + }, + { + "file": "$TESTCASE_ROOT/lib.ml", + "start": { + "line": 2, + "col": 4 + }, + "end": { + "line": 2, + "col": 7 + }, + "stale": true } ] From 6ad695f94493c471520a7ab32c78fe76df3075c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 16 Apr 2025 16:52:12 -0400 Subject: [PATCH 10/53] Fix compat check --- .github/workflows/ocaml-lsp-compat.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ocaml-lsp-compat.yml b/.github/workflows/ocaml-lsp-compat.yml index 440e03e72b..ddb6690747 100644 --- a/.github/workflows/ocaml-lsp-compat.yml +++ b/.github/workflows/ocaml-lsp-compat.yml @@ -51,6 +51,6 @@ jobs: - name: Check that Merlin and OCaml-LSP are co-installable run: | - opam --cli=2.1 pin --with-version=dev --no-action https://github.com/liam923/ocaml-lsp.git#stale-occurrences + opam --cli=2.1 pin --with-version=dev --no-action https://github.com/liam923/ocaml-lsp.git opam --cli=2.1 pin --with-version=5.4-503 --no-action . opam install ocaml-lsp-server --ignore-constraints-on=ocamlformat From 33c02499617e8d3274117c62707fee6e61e7132b Mon Sep 17 00:00:00 2001 From: Ulysse <5031221+voodoos@users.noreply.github.com> Date: Wed, 16 Apr 2025 17:19:08 -0400 Subject: [PATCH 11/53] Update ocaml-lsp-compat.yml --- .github/workflows/ocaml-lsp-compat.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/ocaml-lsp-compat.yml b/.github/workflows/ocaml-lsp-compat.yml index ddb6690747..8def1b2091 100644 --- a/.github/workflows/ocaml-lsp-compat.yml +++ b/.github/workflows/ocaml-lsp-compat.yml @@ -51,6 +51,6 @@ jobs: - name: Check that Merlin and OCaml-LSP are co-installable run: | - opam --cli=2.1 pin --with-version=dev --no-action https://github.com/liam923/ocaml-lsp.git + opam --cli=2.1 pin --with-version=dev --no-action https://github.com/ocaml/ocaml-lsp.git opam --cli=2.1 pin --with-version=5.4-503 --no-action . opam install ocaml-lsp-server --ignore-constraints-on=ocamlformat From 4b31f6e5a8b56bcb3190e652cb61fcdfa4a84bb9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 28 Apr 2025 13:44:31 +0200 Subject: [PATCH 12/53] Add a test illustrating issue #1523 --- tests/test-dirs/signature-help/issue1523.t | 54 ++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 tests/test-dirs/signature-help/issue1523.t diff --git a/tests/test-dirs/signature-help/issue1523.t b/tests/test-dirs/signature-help/issue1523.t new file mode 100644 index 0000000000..955a9ef6ba --- /dev/null +++ b/tests/test-dirs/signature-help/issue1523.t @@ -0,0 +1,54 @@ + $ cat >test.ml <<'EOF' + > module M : sig + > val f : int -> unit + > end = struct + > let f (_ : int) = () + > end + > + > let () = M.f (* keep whitespace *) + > EOF + + $ $MERLIN single signature-help -position 7:13 -filename test unit", + "parameters": [ + { + "label": [ + 6, + 9 + ] + } + ] + } + ], + "activeParameter": 0, + "activeSignature": 0 + }, + "notifications": [] + } + +FIXME: Signature help does not appear for M.f: + + $ cat >test.ml <<'EOF' + > + > type t = int -> unit + > + > module M : sig + > val f : t + > end = struct + > let f (_ : int) = () + > end + > + > let () = M.f (* keep whitespace *) + > EOF + + $ $MERLIN single signature-help -position 7:13 -filename test Date: Mon, 28 Apr 2025 13:46:35 +0200 Subject: [PATCH 13/53] Use merlin issue number --- tests/test-dirs/signature-help/{issue1523.t => issue1927.t} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/test-dirs/signature-help/{issue1523.t => issue1927.t} (100%) diff --git a/tests/test-dirs/signature-help/issue1523.t b/tests/test-dirs/signature-help/issue1927.t similarity index 100% rename from tests/test-dirs/signature-help/issue1523.t rename to tests/test-dirs/signature-help/issue1927.t From 5469ff3bbec5194619301c47a8f5392cd44b29ce Mon Sep 17 00:00:00 2001 From: Tim-ats-d Date: Mon, 5 May 2025 14:42:15 +0200 Subject: [PATCH 14/53] Add test to handle class type behavior in outline. --- tests/test-dirs/outline.t/foo.ml | 77 ++++-- tests/test-dirs/outline.t/run.t | 406 +++++++++++++++++++++++++++---- 2 files changed, 425 insertions(+), 58 deletions(-) diff --git a/tests/test-dirs/outline.t/foo.ml b/tests/test-dirs/outline.t/foo.ml index cd2624174a..2e5e65e0ae 100644 --- a/tests/test-dirs/outline.t/foo.ml +++ b/tests/test-dirs/outline.t/foo.ml @@ -1,28 +1,73 @@ module Bar = struct - type t = int - module type S1 = sig - type t + type t = int + module type S1 = sig + type t - val foo : t -> int - end + val foo : t -> int + end + + class type b = object end end class type class_type_a = object method a : int -> int end -class class_b = object - method b s = s ^ s -end +class class_b = + object + method b s = s ^ s + end exception Ex of char -type ('a, 'b) eithery = - | Lefty of 'a - | Righty of 'b +type ('a, 'b) eithery = Lefty of 'a | Righty of 'b + +type 'a point = { x : 'a; y : 'a; z : 'a } + +class a = object end + +and b = object end + +and c = object end + +class type ta = object end + +and tb = object end + +class b = + object + val foo = 10 + method bar () = print_endline "bar" + end + +and c = object end + +class a = + object + val b = + object + method inside_a_b () = + let x_inside_a_b = 10 in + print_int x_inside_a_b + end + end + +and b = + object + val foo = 10 + method bar = print_endline "bar" + end + +class type ta = object + method baz : int -> int -> string +end + +and tb = object end -type 'a point = - { x : 'a - ; y : 'a - ; z : 'a - } +let final_let = + let c = + object + method foo = 10 + end + in + c diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index e74affc88d..bfdd40d5a2 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -1,29 +1,305 @@ $ echo "S .\nB .\nFLG -nopervasives" > .merlin +TODO: handle class type +TODO: handle nested method and values in class type $ $MERLIN single outline < foo.ml { "class": "return", "value": [ { "start": { - "line": 24, + "line": 67, "col": 0 }, "end": { - "line": 28, + "line": 73, "col": 3 }, + "name": "final_let", + "kind": "Value", + "type": "< foo : int >", + "children": [], + "deprecated": false + }, + { + "start": { + "line": 65, + "col": 0 + }, + "end": { + "line": 65, + "col": 19 + }, + "name": "tb", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 61, + "col": 0 + }, + "end": { + "line": 63, + "col": 3 + }, + "name": "ta", + "kind": "ClassType", + "type": null, + "children": [ + { + "start": { + "line": 62, + "col": 9 + }, + "end": { + "line": 62, + "col": 12 + }, + "name": "baz", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 55, + "col": 0 + }, + "end": { + "line": 59, + "col": 5 + }, + "name": "b", + "kind": "Class", + "type": null, + "children": [ + { + "start": { + "line": 58, + "col": 11 + }, + "end": { + "line": 58, + "col": 14 + }, + "name": "bar", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 57, + "col": 8 + }, + "end": { + "line": 57, + "col": 11 + }, + "name": "foo", + "kind": "Value", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 45, + "col": 0 + }, + "end": { + "line": 53, + "col": 5 + }, + "name": "a", + "kind": "Class", + "type": null, + "children": [ + { + "start": { + "line": 47, + "col": 8 + }, + "end": { + "line": 47, + "col": 9 + }, + "name": "b", + "kind": "Value", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 43, + "col": 0 + }, + "end": { + "line": 43, + "col": 18 + }, + "name": "c", + "kind": "Class", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 37, + "col": 0 + }, + "end": { + "line": 41, + "col": 5 + }, + "name": "b", + "kind": "Class", + "type": null, + "children": [ + { + "start": { + "line": 40, + "col": 11 + }, + "end": { + "line": 40, + "col": 14 + }, + "name": "bar", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 39, + "col": 8 + }, + "end": { + "line": 39, + "col": 11 + }, + "name": "foo", + "kind": "Value", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 35, + "col": 0 + }, + "end": { + "line": 35, + "col": 19 + }, + "name": "tb", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 33, + "col": 0 + }, + "end": { + "line": 33, + "col": 26 + }, + "name": "ta", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 31, + "col": 0 + }, + "end": { + "line": 31, + "col": 18 + }, + "name": "c", + "kind": "Class", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 29, + "col": 0 + }, + "end": { + "line": 29, + "col": 18 + }, + "name": "b", + "kind": "Class", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 27, + "col": 0 + }, + "end": { + "line": 27, + "col": 20 + }, + "name": "a", + "kind": "Class", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 25, + "col": 0 + }, + "end": { + "line": 25, + "col": 42 + }, "name": "point", "kind": "Type", "type": null, "children": [ { "start": { - "line": 27, - "col": 4 + "line": 25, + "col": 34 }, "end": { - "line": 27, - "col": 10 + "line": 25, + "col": 40 }, "name": "z", "kind": "Label", @@ -33,12 +309,12 @@ }, { "start": { - "line": 26, - "col": 4 + "line": 25, + "col": 26 }, "end": { - "line": 27, - "col": 3 + "line": 25, + "col": 33 }, "name": "y", "kind": "Label", @@ -49,11 +325,11 @@ { "start": { "line": 25, - "col": 4 + "col": 18 }, "end": { - "line": 26, - "col": 3 + "line": 25, + "col": 25 }, "name": "x", "kind": "Label", @@ -66,12 +342,12 @@ }, { "start": { - "line": 20, + "line": 23, "col": 0 }, "end": { - "line": 22, - "col": 16 + "line": 23, + "col": 50 }, "name": "eithery", "kind": "Type", @@ -79,12 +355,12 @@ "children": [ { "start": { - "line": 22, - "col": 2 + "line": 23, + "col": 36 }, "end": { - "line": 22, - "col": 16 + "line": 23, + "col": 50 }, "name": "Righty", "kind": "Constructor", @@ -94,12 +370,12 @@ }, { "start": { - "line": 21, - "col": 2 + "line": 23, + "col": 24 }, "end": { - "line": 21, - "col": 15 + "line": 23, + "col": 35 }, "name": "Lefty", "kind": "Constructor", @@ -112,11 +388,11 @@ }, { "start": { - "line": 18, + "line": 21, "col": 0 }, "end": { - "line": 18, + "line": 21, "col": 20 }, "name": "Ex", @@ -127,12 +403,12 @@ }, { "start": { - "line": 14, + "line": 16, "col": 0 }, "end": { - "line": 16, - "col": 3 + "line": 19, + "col": 5 }, "name": "class_b", "kind": "Class", @@ -140,12 +416,12 @@ "children": [ { "start": { - "line": 15, - "col": 9 + "line": 18, + "col": 11 }, "end": { - "line": 15, - "col": 10 + "line": 18, + "col": 12 }, "name": "b", "kind": "Method", @@ -156,27 +432,73 @@ ], "deprecated": false }, + { + "start": { + "line": 12, + "col": 0 + }, + "end": { + "line": 14, + "col": 3 + }, + "name": "class_type_a", + "kind": "ClassType", + "type": null, + "children": [ + { + "start": { + "line": 13, + "col": 2 + }, + "end": { + "line": 13, + "col": 23 + }, + "name": "a", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, { "start": { "line": 1, "col": 0 }, "end": { - "line": 8, + "line": 10, "col": 3 }, "name": "Bar", "kind": "Module", "type": null, "children": [ + { + "start": { + "line": 9, + "col": 2 + }, + "end": { + "line": 9, + "col": 27 + }, + "name": "b", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, { "start": { "line": 3, - "col": 1 + "col": 2 }, "end": { "line": 7, - "col": 4 + "col": 5 }, "name": "S1", "kind": "Signature", @@ -185,11 +507,11 @@ { "start": { "line": 6, - "col": 3 + "col": 4 }, "end": { "line": 6, - "col": 21 + "col": 22 }, "name": "foo", "kind": "Value", @@ -200,11 +522,11 @@ { "start": { "line": 4, - "col": 3 + "col": 4 }, "end": { "line": 4, - "col": 9 + "col": 10 }, "name": "t", "kind": "Type", @@ -218,11 +540,11 @@ { "start": { "line": 2, - "col": 1 + "col": 2 }, "end": { "line": 2, - "col": 13 + "col": 14 }, "name": "t", "kind": "Type", From 317f5ec8605d19ab1bf953715b3ae3691acc8f8e Mon Sep 17 00:00:00 2001 From: Tim-ats-d Date: Mon, 5 May 2025 15:35:59 +0200 Subject: [PATCH 15/53] Handle class type in outline. --- CHANGES.md | 1 + src/analysis/outline.ml | 47 ++++++++++++++++++++++++--------- src/commands/query_json.ml | 1 + src/frontend/query_protocol.ml | 1 + tests/test-dirs/outline.t/run.t | 6 ++--- 5 files changed, 40 insertions(+), 16 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 88e294e377..e44ace82e5 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,6 +9,7 @@ unreleased - `occurrences` now reports stale files (#1885) - `inlay-hints` fix inlay hints on function parameters (#1923) - Fix issues with ident validation and Lid comparison for occurrences (#1924) + + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) diff --git a/src/analysis/outline.ml b/src/analysis/outline.ml index 6b9a39750d..fd6325c6df 100644 --- a/src/analysis/outline.ml +++ b/src/analysis/outline.ml @@ -53,6 +53,11 @@ let get_class_field_desc_infos = function | Typedtree.Tcf_method (str_loc, _, _) -> Some (str_loc, `Method) | _ -> None +let get_class_signature_field_desc_infos = function + | Typedtree.Tctf_val (outline_name, _, _, _) -> Some (outline_name, `Value) + | Typedtree.Tctf_method (outline_name, _, _, _) -> Some (outline_name, `Method) + | _ -> None + let outline_type ~env typ = let ppf, to_string = Format.to_string () in Printtyp.wrap_printing_env env (fun () -> @@ -141,6 +146,13 @@ let rec summarize node = in let deprecated = Type_utils.is_deprecated cd.ci_attributes in Some (mk ~children ~location `Class None cd.ci_id_class_type ~deprecated) + | Class_type_declaration ctd -> + let children = + List.concat_map (Lazy.force node.t_children) ~f:get_class_elements + in + let deprecated = Type_utils.is_deprecated ctd.ci_attributes in + Some + (mk ~children ~location `ClassType None ctd.ci_id_class_type ~deprecated) | _ -> None and get_class_elements node = @@ -151,20 +163,31 @@ and get_class_elements node = List.filter_map (Lazy.force node.t_children) ~f:(fun child -> match child.t_node with | Class_field cf -> begin - match get_class_field_desc_infos cf.cf_desc with - | Some (str_loc, outline_kind) -> - let deprecated = Type_utils.is_deprecated cf.cf_attributes in - Some - { Query_protocol.outline_name = str_loc.Location.txt; - outline_kind; - outline_type = None; - location = str_loc.Location.loc; - children = []; - deprecated - } - | None -> None + cf.cf_desc |> get_class_field_desc_infos + |> Option.map ~f:(fun (str_loc, outline_kind) -> + let deprecated = Type_utils.is_deprecated cf.cf_attributes in + { Query_protocol.outline_name = str_loc.Location.txt; + outline_kind; + outline_type = None; + location = str_loc.Location.loc; + children = []; + deprecated + }) end | _ -> None) + | Class_type { cltyp_desc = Tcty_signature { csig_fields; _ }; _ } -> + List.filter_map csig_fields ~f:(fun field -> + get_class_signature_field_desc_infos field.ctf_desc + |> Option.map ~f:(fun (name, outline_kind) -> + let deprecated = Type_utils.is_deprecated field.ctf_attributes in + { Query_protocol.outline_name = name; + outline_kind; + outline_type = None; + location = field.ctf_loc; + (* TODO: could we have more precised location information? *) + children = []; + deprecated + })) | _ -> [] and get_mod_children node = diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index 69e2e336f5..d108b20e3f 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -227,6 +227,7 @@ let string_of_completion_kind = function | `MethodCall -> "#" | `Exn -> "Exn" | `Class -> "Class" + | `ClassType -> "ClassType" | `Keyword -> "Keyword" let with_location ?(with_file = false) ?(skip_none = false) loc assoc = diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index 4c9e9ffaea..75c00c3c6e 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -88,6 +88,7 @@ and item = | `Type | `Exn | `Class + | `ClassType | `Method ]; outline_type : string option; deprecated : bool; diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index bfdd40d5a2..f864a9e1ea 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -1,6 +1,4 @@ $ echo "S .\nB .\nFLG -nopervasives" > .merlin -TODO: handle class type -TODO: handle nested method and values in class type $ $MERLIN single outline < foo.ml { "class": "return", @@ -51,11 +49,11 @@ TODO: handle nested method and values in class type { "start": { "line": 62, - "col": 9 + "col": 2 }, "end": { "line": 62, - "col": 12 + "col": 35 }, "name": "baz", "kind": "Method", From 63cd0b5c6b79697e326d4d49c2a79c6afb231efe Mon Sep 17 00:00:00 2001 From: Tim-ats-d Date: Wed, 7 May 2025 15:59:15 +0200 Subject: [PATCH 16/53] Add change entry. --- CHANGES.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index e44ace82e5..b073cc300b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,7 +9,7 @@ unreleased - `occurrences` now reports stale files (#1885) - `inlay-hints` fix inlay hints on function parameters (#1923) - Fix issues with ident validation and Lid comparison for occurrences (#1924) - + - Handle class type in outline (#1932) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From 6c7511de5d913f7b1f79735268bde3a853181829 Mon Sep 17 00:00:00 2001 From: Tim-ats-d Date: Mon, 5 May 2025 15:51:09 +0200 Subject: [PATCH 17/53] Add tests for outline generation in .mli. --- tests/test-dirs/outline.t/foo.mli | 56 +++++ tests/test-dirs/outline.t/path.mli | 5 + tests/test-dirs/outline.t/run.t | 382 +++++++++++++++++++++++++++++ 3 files changed, 443 insertions(+) create mode 100644 tests/test-dirs/outline.t/foo.mli create mode 100644 tests/test-dirs/outline.t/path.mli diff --git a/tests/test-dirs/outline.t/foo.mli b/tests/test-dirs/outline.t/foo.mli new file mode 100644 index 0000000000..6fbf591b45 --- /dev/null +++ b/tests/test-dirs/outline.t/foo.mli @@ -0,0 +1,56 @@ +module Bar : sig + type t = int + + module type S1 = sig + type t + val foo : t -> int + end +end + +class type class_type_a = object + method a : int -> int +end + +class class_b : object + method b : string -> string +end + +exception Ex of char + +type ('a, 'b) eithery = Lefty of 'a | Righty of 'b + +type 'a point = { x : 'a; y : 'a; z : 'a } + +class a : object end + +and b : object end + +and c : object end + +class type ta = object end + +and tb = object end + +class b : object + val foo : int + method bar : unit -> unit +end + +and c : object end + +class a : object + val b : < inside_a_b : unit -> unit > +end + +and b : object + val foo : int + method bar : unit +end + +class type ta = object + method baz : int -> int -> string +end + +and tb = object end + +val final_let : < foo : int > diff --git a/tests/test-dirs/outline.t/path.mli b/tests/test-dirs/outline.t/path.mli new file mode 100644 index 0000000000..c8df0f1a26 --- /dev/null +++ b/tests/test-dirs/outline.t/path.mli @@ -0,0 +1,5 @@ +module A : sig + type a = int +end + +val x : A.a diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index f864a9e1ea..7c36077da9 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -562,3 +562,385 @@ $ $MERLIN single outline -short-paths < path.ml | jq '.value[].type' "a" null + $ $MERLIN single outline -filename foo.mli < foo.mli + { + "class": "return", + "value": [ + { + "start": { + "line": 56, + "col": 0 + }, + "end": { + "line": 56, + "col": 29 + }, + "name": "final_let", + "kind": "Value", + "type": "< foo : int >", + "children": [], + "deprecated": false + }, + { + "start": { + "line": 54, + "col": 0 + }, + "end": { + "line": 54, + "col": 19 + }, + "name": "tb", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 50, + "col": 0 + }, + "end": { + "line": 52, + "col": 3 + }, + "name": "ta", + "kind": "ClassType", + "type": null, + "children": [ + { + "start": { + "line": 51, + "col": 2 + }, + "end": { + "line": 51, + "col": 35 + }, + "name": "baz", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 32, + "col": 0 + }, + "end": { + "line": 32, + "col": 19 + }, + "name": "tb", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 30, + "col": 0 + }, + "end": { + "line": 30, + "col": 26 + }, + "name": "ta", + "kind": "ClassType", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 22, + "col": 0 + }, + "end": { + "line": 22, + "col": 42 + }, + "name": "point", + "kind": "Type", + "type": null, + "children": [ + { + "start": { + "line": 22, + "col": 34 + }, + "end": { + "line": 22, + "col": 40 + }, + "name": "z", + "kind": "Label", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 22, + "col": 26 + }, + "end": { + "line": 22, + "col": 33 + }, + "name": "y", + "kind": "Label", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 22, + "col": 18 + }, + "end": { + "line": 22, + "col": 25 + }, + "name": "x", + "kind": "Label", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 20, + "col": 0 + }, + "end": { + "line": 20, + "col": 50 + }, + "name": "eithery", + "kind": "Type", + "type": null, + "children": [ + { + "start": { + "line": 20, + "col": 36 + }, + "end": { + "line": 20, + "col": 50 + }, + "name": "Righty", + "kind": "Constructor", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 20, + "col": 24 + }, + "end": { + "line": 20, + "col": 35 + }, + "name": "Lefty", + "kind": "Constructor", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 18, + "col": 0 + }, + "end": { + "line": 18, + "col": 20 + }, + "name": "Ex", + "kind": "Exn", + "type": null, + "children": [], + "deprecated": false + }, + { + "start": { + "line": 10, + "col": 0 + }, + "end": { + "line": 12, + "col": 3 + }, + "name": "class_type_a", + "kind": "ClassType", + "type": null, + "children": [ + { + "start": { + "line": 11, + "col": 2 + }, + "end": { + "line": 11, + "col": 23 + }, + "name": "a", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 1, + "col": 0 + }, + "end": { + "line": 8, + "col": 3 + }, + "name": "Bar", + "kind": "Module", + "type": null, + "children": [ + { + "start": { + "line": 4, + "col": 2 + }, + "end": { + "line": 7, + "col": 5 + }, + "name": "S1", + "kind": "Signature", + "type": null, + "children": [ + { + "start": { + "line": 6, + "col": 4 + }, + "end": { + "line": 6, + "col": 22 + }, + "name": "foo", + "kind": "Value", + "type": "t -> int", + "children": [], + "deprecated": false + }, + { + "start": { + "line": 5, + "col": 4 + }, + "end": { + "line": 5, + "col": 10 + }, + "name": "t", + "kind": "Type", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + }, + { + "start": { + "line": 2, + "col": 2 + }, + "end": { + "line": 2, + "col": 14 + }, + "name": "t", + "kind": "Type", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + } + ], + "notifications": [] + } + + $ $MERLIN single outline -filename path.mli < path.mli + { + "class": "return", + "value": [ + { + "start": { + "line": 5, + "col": 0 + }, + "end": { + "line": 5, + "col": 11 + }, + "name": "x", + "kind": "Value", + "type": "A.a", + "children": [], + "deprecated": false + }, + { + "start": { + "line": 1, + "col": 0 + }, + "end": { + "line": 3, + "col": 3 + }, + "name": "A", + "kind": "Module", + "type": null, + "children": [ + { + "start": { + "line": 2, + "col": 2 + }, + "end": { + "line": 2, + "col": 14 + }, + "name": "a", + "kind": "Type", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + } + ], + "notifications": [] + } From 782b4fc2d8b6373ff38ef4f69815cd6674ea59f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= Date: Fri, 16 May 2025 16:04:56 +0200 Subject: [PATCH 18/53] Fix outline test to handle object expression inside a let. --- tests/test-dirs/outline.t/run.t | 68 ++++++++++++++++++++++++++++++++- 1 file changed, 66 insertions(+), 2 deletions(-) diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index 7c36077da9..605c0c9796 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -15,7 +15,39 @@ "name": "final_let", "kind": "Value", "type": "< foo : int >", - "children": [], + "children": [ + { + "start": { + "line": 68, + "col": 2 + }, + "end": { + "line": 71, + "col": 7 + }, + "name": "c", + "kind": "Value", + "type": null, + "children": [ + { + "start": { + "line": 70, + "col": 13 + }, + "end": { + "line": 70, + "col": 16 + }, + "name": "foo", + "kind": "Method", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + } + ], "deprecated": false }, { @@ -135,7 +167,39 @@ "name": "b", "kind": "Value", "type": null, - "children": [], + "children": [ + { + "start": { + "line": 49, + "col": 15 + }, + "end": { + "line": 49, + "col": 25 + }, + "name": "inside_a_b", + "kind": "Method", + "type": null, + "children": [ + { + "start": { + "line": 50, + "col": 10 + }, + "end": { + "line": 50, + "col": 31 + }, + "name": "x_inside_a_b", + "kind": "Value", + "type": null, + "children": [], + "deprecated": false + } + ], + "deprecated": false + } + ], "deprecated": false } ], From da5687a34dee6c56da5a57e3f75e9780afae3b21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= Date: Fri, 16 May 2025 16:05:22 +0200 Subject: [PATCH 19/53] Handle object expression inside a let in outline. --- src/analysis/outline.ml | 69 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 61 insertions(+), 8 deletions(-) diff --git a/src/analysis/outline.ml b/src/analysis/outline.ml index fd6325c6df..c728a9da86 100644 --- a/src/analysis/outline.ml +++ b/src/analysis/outline.ml @@ -48,11 +48,6 @@ let mk ?(children = []) ~location ~deprecated outline_kind outline_type id = deprecated } -let get_class_field_desc_infos = function - | Typedtree.Tcf_val (str_loc, _, _, _, _) -> Some (str_loc, `Value) - | Typedtree.Tcf_method (str_loc, _, _) -> Some (str_loc, `Method) - | _ -> None - let get_class_signature_field_desc_infos = function | Typedtree.Tctf_val (outline_name, _, _, _) -> Some (outline_name, `Value) | Typedtree.Tctf_method (outline_name, _, _, _) -> Some (outline_name, `Method) @@ -69,13 +64,16 @@ let rec summarize node = let location = node.t_loc in match node.t_node with | Value_binding vb -> + let children = + List.concat_map (Lazy.force node.t_children) ~f:get_val_elements + in let deprecated = Type_utils.is_deprecated vb.vb_attributes in begin match id_of_patt vb.vb_pat with | None -> None | Some ident -> let typ = outline_type ~env:node.t_env vb.vb_pat.pat_type in - Some (mk ~location ~deprecated `Value typ ident) + Some (mk ~children ~location ~deprecated `Value typ ident) end | Value_description vd -> let deprecated = Type_utils.is_deprecated vd.val_attributes in @@ -155,6 +153,24 @@ let rec summarize node = (mk ~children ~location `ClassType None ctd.ci_id_class_type ~deprecated) | _ -> None +and get_val_elements node = + match node.t_node with + | Expression _ -> + List.concat_map (Lazy.force node.t_children) ~f:get_val_elements + | Value_binding vb -> + let children = + List.concat_map (Lazy.force node.t_children) ~f:get_val_elements + in + let deprecated = Type_utils.is_deprecated vb.vb_attributes in + begin + match id_of_patt vb.vb_pat with + | None -> [] + | Some ident -> + [ mk ~children ~location:node.t_loc ~deprecated `Value None ident ] + end + | Class_expr _ | Class_structure _ -> get_class_elements node + | _ -> [] + and get_class_elements node = match node.t_node with | Class_expr _ -> @@ -164,13 +180,13 @@ and get_class_elements node = match child.t_node with | Class_field cf -> begin cf.cf_desc |> get_class_field_desc_infos - |> Option.map ~f:(fun (str_loc, outline_kind) -> + |> Option.map ~f:(fun (str_loc, outline_kind, children) -> let deprecated = Type_utils.is_deprecated cf.cf_attributes in { Query_protocol.outline_name = str_loc.Location.txt; outline_kind; outline_type = None; location = str_loc.Location.loc; - children = []; + children; deprecated }) end @@ -190,6 +206,43 @@ and get_class_elements node = })) | _ -> [] +and get_class_field_desc_infos = function + | Typedtree.Tcf_val (str_loc, _, _, field_kind, _) -> + Some (str_loc, `Value, get_class_field_kind_elements field_kind) + | Typedtree.Tcf_method (str_loc, _, field_kind) -> + Some (str_loc, `Method, get_class_field_kind_elements field_kind) + | _ -> None + +and get_class_field_kind_elements = function + | Tcfk_virtual _ -> [] + | Tcfk_concrete (_, expr) -> get_expr_elements expr + +and get_expr_elements expr = + match expr.exp_desc with + | Texp_let (_, vbs, expr) -> + List.filter_map vbs ~f:(fun vb -> + id_of_patt vb.vb_pat + |> Option.map ~f:(fun ident -> + let children = get_expr_elements vb.vb_expr in + let deprecated = Type_utils.is_deprecated vb.vb_attributes in + + mk ~children ~location:vb.vb_loc ~deprecated `Value None ident)) + @ get_expr_elements expr + | Texp_object ({ cstr_fields; _ }, _) -> + List.filter_map cstr_fields ~f:(fun field -> + field.cf_desc |> get_class_field_desc_infos + |> Option.map ~f:(fun (str_loc, outline_kind, children) -> + let deprecated = Type_utils.is_deprecated field.cf_attributes in + { Query_protocol.outline_name = str_loc.Location.txt; + outline_kind; + outline_type = None; + location = str_loc.Location.loc; + children; + deprecated + })) + | Texp_function (_, Tfunction_body expr) -> get_expr_elements expr + | _ -> [] + and get_mod_children node = List.concat_map (Lazy.force node.t_children) ~f:remove_mod_indir From 73604f1b8a03908f32de5f31b277a31e472a8296 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Tim=C3=A9o=20Arnouts?= Date: Fri, 16 May 2025 16:16:52 +0200 Subject: [PATCH 20/53] Add change entry. --- CHANGES.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGES.md b/CHANGES.md index b073cc300b..cf0c84ed48 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -10,6 +10,7 @@ unreleased - `inlay-hints` fix inlay hints on function parameters (#1923) - Fix issues with ident validation and Lid comparison for occurrences (#1924) - Handle class type in outline (#1932) + - Handle locally defined value in outline (#1936) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From 5fee53a7f41cd9baadfe0575a150a8b6a1557d61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 20 May 2025 12:35:16 +0200 Subject: [PATCH 21/53] Rely more on the flat browse tree structure --- src/analysis/outline.ml | 69 ++++++++++++----------------------------- 1 file changed, 20 insertions(+), 49 deletions(-) diff --git a/src/analysis/outline.ml b/src/analysis/outline.ml index c728a9da86..84e88829a1 100644 --- a/src/analysis/outline.ml +++ b/src/analysis/outline.ml @@ -175,22 +175,25 @@ and get_class_elements node = match node.t_node with | Class_expr _ -> List.concat_map (Lazy.force node.t_children) ~f:get_class_elements + | Class_field cf -> + let children = + List.concat_map (Lazy.force node.t_children) ~f:get_class_elements + in + cf.cf_desc |> get_class_field_desc_infos + |> Option.map ~f:(fun (str_loc, outline_kind) -> + let deprecated = Type_utils.is_deprecated cf.cf_attributes in + { Query_protocol.outline_name = str_loc.Location.txt; + outline_kind; + outline_type = None; + location = str_loc.Location.loc; + children; + deprecated + }) + |> Option.to_list + | Class_field_kind _ -> + List.concat_map (Lazy.force node.t_children) ~f:get_val_elements | Class_structure _ -> - List.filter_map (Lazy.force node.t_children) ~f:(fun child -> - match child.t_node with - | Class_field cf -> begin - cf.cf_desc |> get_class_field_desc_infos - |> Option.map ~f:(fun (str_loc, outline_kind, children) -> - let deprecated = Type_utils.is_deprecated cf.cf_attributes in - { Query_protocol.outline_name = str_loc.Location.txt; - outline_kind; - outline_type = None; - location = str_loc.Location.loc; - children; - deprecated - }) - end - | _ -> None) + List.concat_map (Lazy.force node.t_children) ~f:get_class_elements | Class_type { cltyp_desc = Tcty_signature { csig_fields; _ }; _ } -> List.filter_map csig_fields ~f:(fun field -> get_class_signature_field_desc_infos field.ctf_desc @@ -207,42 +210,10 @@ and get_class_elements node = | _ -> [] and get_class_field_desc_infos = function - | Typedtree.Tcf_val (str_loc, _, _, field_kind, _) -> - Some (str_loc, `Value, get_class_field_kind_elements field_kind) - | Typedtree.Tcf_method (str_loc, _, field_kind) -> - Some (str_loc, `Method, get_class_field_kind_elements field_kind) + | Typedtree.Tcf_val (str_loc, _, _, _field_kind, _) -> Some (str_loc, `Value) + | Typedtree.Tcf_method (str_loc, _, _field_kind) -> Some (str_loc, `Method) | _ -> None -and get_class_field_kind_elements = function - | Tcfk_virtual _ -> [] - | Tcfk_concrete (_, expr) -> get_expr_elements expr - -and get_expr_elements expr = - match expr.exp_desc with - | Texp_let (_, vbs, expr) -> - List.filter_map vbs ~f:(fun vb -> - id_of_patt vb.vb_pat - |> Option.map ~f:(fun ident -> - let children = get_expr_elements vb.vb_expr in - let deprecated = Type_utils.is_deprecated vb.vb_attributes in - - mk ~children ~location:vb.vb_loc ~deprecated `Value None ident)) - @ get_expr_elements expr - | Texp_object ({ cstr_fields; _ }, _) -> - List.filter_map cstr_fields ~f:(fun field -> - field.cf_desc |> get_class_field_desc_infos - |> Option.map ~f:(fun (str_loc, outline_kind, children) -> - let deprecated = Type_utils.is_deprecated field.cf_attributes in - { Query_protocol.outline_name = str_loc.Location.txt; - outline_kind; - outline_type = None; - location = str_loc.Location.loc; - children; - deprecated - })) - | Texp_function (_, Tfunction_body expr) -> get_expr_elements expr - | _ -> [] - and get_mod_children node = List.concat_map (Lazy.force node.t_children) ~f:remove_mod_indir From 9d0d8d4b6d3fd882fd7533ede62d54e3b61c5e4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 27 May 2025 11:37:51 +0200 Subject: [PATCH 22/53] Slightly more code reuse --- src/analysis/outline.ml | 13 +------------ tests/test-dirs/outline.t/run.t | 4 ++-- 2 files changed, 3 insertions(+), 14 deletions(-) diff --git a/src/analysis/outline.ml b/src/analysis/outline.ml index 84e88829a1..5087d51395 100644 --- a/src/analysis/outline.ml +++ b/src/analysis/outline.ml @@ -157,19 +157,8 @@ and get_val_elements node = match node.t_node with | Expression _ -> List.concat_map (Lazy.force node.t_children) ~f:get_val_elements - | Value_binding vb -> - let children = - List.concat_map (Lazy.force node.t_children) ~f:get_val_elements - in - let deprecated = Type_utils.is_deprecated vb.vb_attributes in - begin - match id_of_patt vb.vb_pat with - | None -> [] - | Some ident -> - [ mk ~children ~location:node.t_loc ~deprecated `Value None ident ] - end | Class_expr _ | Class_structure _ -> get_class_elements node - | _ -> [] + | _ -> Option.to_list (summarize node) and get_class_elements node = match node.t_node with diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index 605c0c9796..3744b31ee0 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -27,7 +27,7 @@ }, "name": "c", "kind": "Value", - "type": null, + "type": "< foo : int >", "children": [ { "start": { @@ -192,7 +192,7 @@ }, "name": "x_inside_a_b", "kind": "Value", - "type": null, + "type": "int", "children": [], "deprecated": false } From fa6f9b2be677f99a31b60c9585ef7759ebb3a762 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 15 May 2025 16:22:43 +0200 Subject: [PATCH 23/53] Reduce distance with upstream --- src/ocaml/typing/types.ml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml index a9c8c59d1f..c491ea45f6 100644 --- a/src/ocaml/typing/types.ml +++ b/src/ocaml/typing/types.ml @@ -515,9 +515,7 @@ type changes = | Unchanged | Invalid -open Local_store - -let trail = s_table ref Unchanged +let trail = Local_store.s_table ref Unchanged let log_change ch = let r' = ref Unchanged in @@ -815,7 +813,7 @@ let undo_change = function type snapshot = changes ref * int let last_snapshot = Local_store.s_ref 0 -let linked_variables = s_ref 0 +let linked_variables = Local_store.s_ref 0 let log_type ty = if ty.id <= !last_snapshot then log_change (Ctype (ty, ty.desc)) From 61f911b7db6761c7aec2839311eac0b1ab6ad055 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 15 May 2025 17:06:24 +0200 Subject: [PATCH 24/53] Add debug printing --- src/ocaml/typing/short_paths_graph.ml | 16 ++++++++++------ src/ocaml/typing/types.ml | 2 +- 2 files changed, 11 insertions(+), 7 deletions(-) diff --git a/src/ocaml/typing/short_paths_graph.ml b/src/ocaml/typing/short_paths_graph.ml index c3d9d8bfcd..b3ed9e437d 100644 --- a/src/ocaml/typing/short_paths_graph.ml +++ b/src/ocaml/typing/short_paths_graph.ml @@ -14,6 +14,7 @@ module Ident = struct let global name = Ident.create_persistent name + let print_with_scope t = Ident.print_with_scope t end module Ident_map = Map.Make(Ident) @@ -1153,12 +1154,15 @@ end = struct module_type_names = String_map.empty; module_names = String_map.empty; } - let previous_type t id = + let failwith_id msg id = + failwith (Format_doc.asprintf "%s: %a" msg Ident.print_with_scope id) + + let previous_type _desc t id = match Ident_map.find id t.types with | exception Not_found -> None | prev -> match Type.declaration prev with - | None -> failwith "Graph.add: type already defined" + | None -> failwith_id "Graph.add: type already defined" id | Some _ as o -> o let previous_class_type t id = @@ -1166,7 +1170,7 @@ end = struct | exception Not_found -> None | prev -> match Class_type.declaration prev with - | None -> failwith "Graph.add: class type already defined" + | None -> failwith_id "Graph.add: class type already defined" id | Some _ as o -> o let previous_module_type t id = @@ -1174,7 +1178,7 @@ end = struct | exception Not_found -> None | prev -> match Module_type.declaration prev with - | None -> failwith "Graph.add: module type already defined" + | None -> failwith_id "Graph.add: module type already defined" id | Some _ as o -> o let previous_module t id = @@ -1182,7 +1186,7 @@ end = struct | exception Not_found -> None | prev -> match Module.declaration prev with - | None -> failwith "Graph.add: module already defined" + | None -> failwith_id "Graph.add: module already defined" id | Some _ as o -> o let add_name source id names = @@ -1213,7 +1217,7 @@ end = struct let rec loop acc diff declarations = function | [] -> loop_declarations acc diff declarations | Component.Type(origin, id, desc, source, dpr) :: rest -> - let prev = previous_type acc id in + let prev = previous_type desc acc id in let typ = Type.base origin id (Some desc) dpr in let types = Ident_map.add id typ acc.types in let type_names = add_name source id acc.type_names in diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml index c491ea45f6..f0c9166bc6 100644 --- a/src/ocaml/typing/types.ml +++ b/src/ocaml/typing/types.ml @@ -639,7 +639,7 @@ module Transient_expr = struct let get_marks ty = ty.scope lsr 27 let set_scope ty sc = if (sc land marks_mask <> 0) then - invalid_arg "Types.Transient_expr.set_scope"; + invalid_arg(Format.sprintf "Types.Transient_expr.set_scope %i" sc); ty.scope <- (ty.scope land marks_mask) lor sc let try_mark_node mark ty = match mark with From 581dd14016aae412b87d084f8d3dc20e623575be Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 15 May 2025 17:56:08 +0200 Subject: [PATCH 25/53] Move short path tests to separate folder --- tests/test-dirs/{ => short-paths}/short-paths.t/dep.mli | 0 tests/test-dirs/{ => short-paths}/short-paths.t/run.t | 0 tests/test-dirs/{ => short-paths}/short-paths.t/test.ml | 0 3 files changed, 0 insertions(+), 0 deletions(-) rename tests/test-dirs/{ => short-paths}/short-paths.t/dep.mli (100%) rename tests/test-dirs/{ => short-paths}/short-paths.t/run.t (100%) rename tests/test-dirs/{ => short-paths}/short-paths.t/test.ml (100%) diff --git a/tests/test-dirs/short-paths.t/dep.mli b/tests/test-dirs/short-paths/short-paths.t/dep.mli similarity index 100% rename from tests/test-dirs/short-paths.t/dep.mli rename to tests/test-dirs/short-paths/short-paths.t/dep.mli diff --git a/tests/test-dirs/short-paths.t/run.t b/tests/test-dirs/short-paths/short-paths.t/run.t similarity index 100% rename from tests/test-dirs/short-paths.t/run.t rename to tests/test-dirs/short-paths/short-paths.t/run.t diff --git a/tests/test-dirs/short-paths.t/test.ml b/tests/test-dirs/short-paths/short-paths.t/test.ml similarity index 100% rename from tests/test-dirs/short-paths.t/test.ml rename to tests/test-dirs/short-paths/short-paths.t/test.ml From 077f7c66b6ab19c3c85cad91c0332d21b21c9e7e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 15 May 2025 17:56:17 +0200 Subject: [PATCH 26/53] Add a test illustrating issue #1913 --- tests/test-dirs/short-paths/double-trouble.t | 14 ++++++++++++++ 1 file changed, 14 insertions(+) create mode 100644 tests/test-dirs/short-paths/double-trouble.t diff --git a/tests/test-dirs/short-paths/double-trouble.t b/tests/test-dirs/short-paths/double-trouble.t new file mode 100644 index 0000000000..9d6b3d736d --- /dev/null +++ b/tests/test-dirs/short-paths/double-trouble.t @@ -0,0 +1,14 @@ +Found in issue #1913 + + $ cat >test.ml < type _ plus = | Zero : 'm plus | Suc : 'm plus -> 'm plus + > type _ has_plus = Plus : 'm plus -> unit has_plus;; + > let (Plus (type mn3) (ed : mn3 plus) ) = Plus (Suc Zero) in ed + 2 + > EOF + + $ $MERLIN single errors -short-paths -filename test.ml < test.ml + { + "class": "failure", + "value": "Graph.add: type already defined: mn3/281[4]", + "notifications": [] + } From 589aa94b2fd23d75db896faf4d81cbbf22cf3b0a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 15 May 2025 17:29:48 +0200 Subject: [PATCH 27/53] Don't add redundant information to the short path graph. Fixes #1913 --- src/ocaml/typing/env.ml | 4 ++-- src/ocaml/typing/env.mli | 4 +++- src/ocaml/typing/typecore.ml | 3 ++- tests/test-dirs/short-paths/double-trouble.t | 19 +++++++++++++++++-- 4 files changed, 24 insertions(+), 6 deletions(-) diff --git a/src/ocaml/typing/env.ml b/src/ocaml/typing/env.ml index fb25f29dd5..d35e3126db 100644 --- a/src/ocaml/typing/env.ml +++ b/src/ocaml/typing/env.ml @@ -2393,9 +2393,9 @@ let enter_value ?check name desc env = let env = store_value ?check id addr desc (Shape.leaf desc.val_uid) env in (id, env) -let enter_type ~scope name info env = +let enter_type ?(long_path = false) ~scope name info env = let id = Ident.create_scoped ~scope name in - let env = store_type ~check:true ~predef:false ~long_path:false + let env = store_type ~check:true ~predef:false ~long_path id info (Shape.leaf info.type_uid) env in (id, env) diff --git a/src/ocaml/typing/env.mli b/src/ocaml/typing/env.mli index f20139ce12..6866dabe38 100644 --- a/src/ocaml/typing/env.mli +++ b/src/ocaml/typing/env.mli @@ -359,7 +359,9 @@ val remove_last_open: Path.t -> t -> t option val enter_value: ?check:(string -> Warnings.t) -> string -> value_description -> t -> Ident.t * t -val enter_type: scope:int -> string -> type_declaration -> t -> Ident.t * t +val enter_type: + ?long_path:bool -> scope:int -> + string -> type_declaration -> t -> Ident.t * t val enter_extension: scope:int -> rebind:bool -> string -> extension_constructor -> t -> Ident.t * t diff --git a/src/ocaml/typing/typecore.ml b/src/ocaml/typing/typecore.ml index 527947c045..06e56fbe34 100644 --- a/src/ocaml/typing/typecore.ml +++ b/src/ocaml/typing/typecore.ml @@ -913,7 +913,8 @@ let solve_constructor_annotation new_local_type ~loc:name.loc Definition ~manifest_and_scope:(tv, Ident.lowest_scope) in let (id, new_env) = - Env.enter_type ~scope:expansion_scope name.txt decl !!penv in + (* These redundant types should not be added to the shortpath graph *) + Env.enter_type ~long_path:true ~scope:expansion_scope name.txt decl !!penv in Pattern_env.set_env penv new_env; ({name with txt = id}, (decl, tv))) name_list diff --git a/tests/test-dirs/short-paths/double-trouble.t b/tests/test-dirs/short-paths/double-trouble.t index 9d6b3d736d..17f66a630c 100644 --- a/tests/test-dirs/short-paths/double-trouble.t +++ b/tests/test-dirs/short-paths/double-trouble.t @@ -8,7 +8,22 @@ Found in issue #1913 $ $MERLIN single errors -short-paths -filename test.ml < test.ml { - "class": "failure", - "value": "Graph.add: type already defined: mn3/281[4]", + "class": "return", + "value": [ + { + "start": { + "line": 3, + "col": 60 + }, + "end": { + "line": 3, + "col": 62 + }, + "type": "typer", + "sub": [], + "valid": true, + "message": "The value ed has type mn3 plus but an expression was expected of type int" + } + ], "notifications": [] } From 3ff78672380b74e7c00cc4d30ea46352048ad1f9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 20 May 2025 10:29:33 +0200 Subject: [PATCH 28/53] wip: Bypass new mask system --- src/ocaml/typing/types.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml index f0c9166bc6..5b6a1854aa 100644 --- a/src/ocaml/typing/types.ml +++ b/src/ocaml/typing/types.ml @@ -600,7 +600,7 @@ let type_marks = let available_marks = Local_store.s_ref type_marks let with_type_mark f = match !available_marks with - | mark :: rem as old -> + | mark :: rem as old when false -> available_marks := rem; let mk = Mark {mark; marked = []} in Misc.try_finally (fun () -> f mk) ~always: begin fun () -> @@ -613,7 +613,7 @@ let with_type_mark f = marked | Hash _ -> () end - | [] -> + | _ -> (* When marks are exhausted, fall back to using a hash table *) f (Hash {visited = TransientTypeHash.create 1}) From 8033fb50012fda93ed5a460564fcc547ed826b30 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 22 May 2025 09:04:54 +0200 Subject: [PATCH 29/53] Revert "wip: Bypass new mask system" This reverts commit b53e7675b1048664a4634a796877905b1e11978e. --- src/ocaml/typing/types.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml index 5b6a1854aa..f0c9166bc6 100644 --- a/src/ocaml/typing/types.ml +++ b/src/ocaml/typing/types.ml @@ -600,7 +600,7 @@ let type_marks = let available_marks = Local_store.s_ref type_marks let with_type_mark f = match !available_marks with - | mark :: rem as old when false -> + | mark :: rem as old -> available_marks := rem; let mk = Mark {mark; marked = []} in Misc.try_finally (fun () -> f mk) ~always: begin fun () -> @@ -613,7 +613,7 @@ let with_type_mark f = marked | Hash _ -> () end - | _ -> + | [] -> (* When marks are exhausted, fall back to using a hash table *) f (Hash {visited = TransientTypeHash.create 1}) From e4d26821467ba261e9724d1145eaabe7e4be6093 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 22 May 2025 09:07:01 +0200 Subject: [PATCH 30/53] Apply upstream scope fix. 474804ad04048775bd92fa0d1baa7bd798cc14c6 --- src/ocaml/typing/types.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/ocaml/typing/types.ml b/src/ocaml/typing/types.ml index f0c9166bc6..945fa13306 100644 --- a/src/ocaml/typing/types.ml +++ b/src/ocaml/typing/types.ml @@ -862,7 +862,7 @@ let set_level ty level = (* TODO: introduce a guard and rename it to set_higher_scope? *) let set_scope ty scope = let ty = repr ty in - let prev_scope = ty.scope land marks_mask in + let prev_scope = ty.scope land scope_mask in if scope <> prev_scope then begin if ty.id <= !last_snapshot then log_change (Cscope (ty, prev_scope)); Transient_expr.set_scope ty scope From 04255e3195c6c93256ddbcacbb64d50e6347d260 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 27 May 2025 11:17:14 +0200 Subject: [PATCH 31/53] Change entries for #1935 --- CHANGES.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index cf0c84ed48..c803046e61 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,6 +11,10 @@ unreleased - Fix issues with ident validation and Lid comparison for occurrences (#1924) - Handle class type in outline (#1932) - Handle locally defined value in outline (#1936) + - Fix a typer issue triggering assertions in the short-paths graph (#1935, + fixes #1913) + - Downstreamed a typer fix from 5.3.X that would trigger assertions linked + to scopes bit masks when backtracking the typer cache (#1935) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From d7897862fc3c40e4e74f01bc6490de6448344c71 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 27 May 2025 13:52:41 +0200 Subject: [PATCH 32/53] Bump cachix/install-nix-action from V28 to 31.3.0 (#1931) Bumps [cachix/install-nix-action](https://github.com/cachix/install-nix-action) from V28 to 31.3.0. This release includes the previously tagged commit. - [Release notes](https://github.com/cachix/install-nix-action/releases) - [Changelog](https://github.com/cachix/install-nix-action/blob/master/RELEASE.md) - [Commits](https://github.com/cachix/install-nix-action/compare/V28...31.3.0) --- updated-dependencies: - dependency-name: cachix/install-nix-action dependency-version: 31.3.0 dependency-type: direct:production ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/nix.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml index 091dde74b7..a4774bc8df 100644 --- a/.github/workflows/nix.yml +++ b/.github/workflows/nix.yml @@ -31,7 +31,7 @@ jobs: with: submodules: true - name: nix - uses: cachix/install-nix-action@V28 + uses: cachix/install-nix-action@31.3.0 with: nix_path: nixpkgs=channel:nixos-unstable - run: nix develop -c dune build @check @runtest -p merlin-lib,dot-merlin-reader,ocaml-index,merlin From 0cd36103a8a20b2bce42a37709280bc0974e43d8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 23 Jun 2025 16:49:08 +0200 Subject: [PATCH 33/53] Add a new `selection` field to outline results that contains the location of the symbol itself. This matches LSP's "selectionRange" and is required for future parity when using merlin's outline implementation in ocaml-lsp-server. --- src/analysis/outline.ml | 52 +- src/commands/query_json.ml | 4 +- src/frontend/query_protocol.ml | 3 +- tests/test-dirs/outline-recovery.t | 48 +- tests/test-dirs/outline.t/run.t | 768 ++++++++++++++++++++++++++--- 5 files changed, 781 insertions(+), 94 deletions(-) diff --git a/src/analysis/outline.ml b/src/analysis/outline.ml index 5087d51395..2d2d170b6a 100644 --- a/src/analysis/outline.ml +++ b/src/analysis/outline.ml @@ -35,16 +35,18 @@ open Typedtree open Browse_raw open Browse_tree -let id_of_patt = function - | { pat_desc = Tpat_var (id, _, _); _ } -> Some id +let name_of_patt = function + | { pat_desc = Tpat_var (_, name, _); _ } -> Some name | _ -> None -let mk ?(children = []) ~location ~deprecated outline_kind outline_type id = +let mk ?(children = []) ~location ~deprecated outline_kind outline_type + (name : string Location.loc) = { Query_protocol.outline_kind; outline_type; location; + selection = name.loc; children; - outline_name = Ident.name id; + outline_name = name.txt; deprecated } @@ -69,38 +71,38 @@ let rec summarize node = in let deprecated = Type_utils.is_deprecated vb.vb_attributes in begin - match id_of_patt vb.vb_pat with + match name_of_patt vb.vb_pat with | None -> None - | Some ident -> + | Some name -> let typ = outline_type ~env:node.t_env vb.vb_pat.pat_type in - Some (mk ~children ~location ~deprecated `Value typ ident) + Some (mk ~children ~location ~deprecated `Value typ name) end | Value_description vd -> let deprecated = Type_utils.is_deprecated vd.val_attributes in let typ = outline_type ~env:node.t_env vd.val_val.val_type in - Some (mk ~location ~deprecated `Value typ vd.val_id) + Some (mk ~location ~deprecated `Value typ vd.val_name) | Module_declaration md -> let children = get_mod_children node in begin - match md.md_id with - | None -> None - | Some id -> + match md.md_name with + | { txt = None; _ } -> None + | { txt = Some txt; loc } -> let deprecated = Type_utils.is_deprecated md.md_attributes in - Some (mk ~children ~location ~deprecated `Module None id) + Some (mk ~children ~location ~deprecated `Module None { txt; loc }) end | Module_binding mb -> let children = get_mod_children node in begin - match mb.mb_id with - | None -> None - | Some id -> + match mb.mb_name with + | { txt = None; _ } -> None + | { txt = Some txt; loc } -> let deprecated = Type_utils.is_deprecated mb.mb_attributes in - Some (mk ~children ~location ~deprecated `Module None id) + Some (mk ~children ~location ~deprecated `Module None { txt; loc }) end | Module_type_declaration mtd -> let children = get_mod_children node in let deprecated = Type_utils.is_deprecated mtd.mtd_attributes in - Some (mk ~deprecated ~children ~location `Modtype None mtd.mtd_id) + Some (mk ~deprecated ~children ~location `Modtype None mtd.mtd_name) | Type_declaration td -> let children = List.concat_map (Lazy.force node.t_children) ~f:(fun child -> @@ -110,15 +112,15 @@ let rec summarize node = match x.t_node with | Constructor_declaration c -> let deprecated = Type_utils.is_deprecated c.cd_attributes in - mk `Constructor None c.cd_id ~deprecated ~location:c.cd_loc + mk `Constructor None c.cd_name ~deprecated ~location:c.cd_loc | Label_declaration ld -> let deprecated = Type_utils.is_deprecated ld.ld_attributes in - mk `Label None ld.ld_id ~deprecated ~location:ld.ld_loc + mk `Label None ld.ld_name ~deprecated ~location:ld.ld_loc | _ -> assert false (* ! *)) | _ -> []) in let deprecated = Type_utils.is_deprecated td.typ_attributes in - Some (mk ~children ~location ~deprecated `Type None td.typ_id) + Some (mk ~children ~location ~deprecated `Type None td.typ_name) | Type_extension te -> let name = Path.name te.tyext_path in let children = @@ -132,25 +134,25 @@ let rec summarize node = outline_kind = `Type; outline_type = None; location; + selection = te.tyext_txt.loc; children; deprecated } | Extension_constructor ec -> let deprecated = Type_utils.is_deprecated ec.ext_attributes in - Some (mk ~location `Exn None ec.ext_id ~deprecated) + Some (mk ~location `Exn None ec.ext_name ~deprecated) | Class_declaration cd -> let children = List.concat_map (Lazy.force node.t_children) ~f:get_class_elements in let deprecated = Type_utils.is_deprecated cd.ci_attributes in - Some (mk ~children ~location `Class None cd.ci_id_class_type ~deprecated) + Some (mk ~children ~location `Class None cd.ci_id_name ~deprecated) | Class_type_declaration ctd -> let children = List.concat_map (Lazy.force node.t_children) ~f:get_class_elements in let deprecated = Type_utils.is_deprecated ctd.ci_attributes in - Some - (mk ~children ~location `ClassType None ctd.ci_id_class_type ~deprecated) + Some (mk ~children ~location `ClassType None ctd.ci_id_name ~deprecated) | _ -> None and get_val_elements node = @@ -175,6 +177,7 @@ and get_class_elements node = outline_kind; outline_type = None; location = str_loc.Location.loc; + selection = str_loc.loc; children; deprecated }) @@ -192,6 +195,7 @@ and get_class_elements node = outline_kind; outline_type = None; location = field.ctf_loc; + selection = field.ctf_loc; (* TODO: could we have more precised location information? *) children = []; deprecated diff --git a/src/commands/query_json.ml b/src/commands/query_json.ml index d108b20e3f..f0c0939bec 100644 --- a/src/commands/query_json.ml +++ b/src/commands/query_json.ml @@ -323,6 +323,7 @@ let rec json_of_outline outline = outline_kind; outline_type; location; + selection; children; deprecated } = @@ -334,7 +335,8 @@ let rec json_of_outline outline = | None -> `Null | Some typ -> `String typ ); ("children", `List (json_of_outline children)); - ("deprecated", `Bool deprecated) + ("deprecated", `Bool deprecated); + ("selection", with_location selection []) ] in List.map ~f:json_of_item outline diff --git a/src/frontend/query_protocol.ml b/src/frontend/query_protocol.ml index 75c00c3c6e..ba845dfb26 100644 --- a/src/frontend/query_protocol.ml +++ b/src/frontend/query_protocol.ml @@ -92,7 +92,8 @@ and item = | `Method ]; outline_type : string option; deprecated : bool; - location : Location_aux.t; + location : Location.t; + selection : Location.t; children : outline } diff --git a/tests/test-dirs/outline-recovery.t b/tests/test-dirs/outline-recovery.t index 9aff32a063..ea23206392 100644 --- a/tests/test-dirs/outline-recovery.t +++ b/tests/test-dirs/outline-recovery.t @@ -36,7 +36,17 @@ "kind": "Module", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 4, + "col": 9 + }, + "end": { + "line": 4, + "col": 10 + } + } }, { "start": { @@ -51,7 +61,17 @@ "kind": "Module", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 3, + "col": 9 + }, + "end": { + "line": 3, + "col": 10 + } + } }, { "start": { @@ -66,10 +86,30 @@ "kind": "Module", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 2, + "col": 9 + }, + "end": { + "line": 2, + "col": 10 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 1, + "col": 7 + }, + "end": { + "line": 1, + "col": 11 + } + } } ], "notifications": [] diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index 3744b31ee0..490a3c402b 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -42,13 +42,43 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 70, + "col": 13 + }, + "end": { + "line": 70, + "col": 16 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 68, + "col": 6 + }, + "end": { + "line": 68, + "col": 7 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 67, + "col": 4 + }, + "end": { + "line": 67, + "col": 13 + } + } }, { "start": { @@ -63,7 +93,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 65, + "col": 4 + }, + "end": { + "line": 65, + "col": 6 + } + } }, { "start": { @@ -91,10 +131,30 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 62, + "col": 2 + }, + "end": { + "line": 62, + "col": 35 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 61, + "col": 11 + }, + "end": { + "line": 61, + "col": 13 + } + } }, { "start": { @@ -122,7 +182,17 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 58, + "col": 11 + }, + "end": { + "line": 58, + "col": 14 + } + } }, { "start": { @@ -137,10 +207,30 @@ "kind": "Value", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 57, + "col": 8 + }, + "end": { + "line": 57, + "col": 11 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 55, + "col": 4 + }, + "end": { + "line": 55, + "col": 5 + } + } }, { "start": { @@ -194,16 +284,56 @@ "kind": "Value", "type": "int", "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 50, + "col": 14 + }, + "end": { + "line": 50, + "col": 26 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 49, + "col": 15 + }, + "end": { + "line": 49, + "col": 25 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 47, + "col": 8 + }, + "end": { + "line": 47, + "col": 9 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 45, + "col": 6 + }, + "end": { + "line": 45, + "col": 7 + } + } }, { "start": { @@ -218,7 +348,17 @@ "kind": "Class", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 43, + "col": 4 + }, + "end": { + "line": 43, + "col": 5 + } + } }, { "start": { @@ -246,7 +386,17 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 40, + "col": 11 + }, + "end": { + "line": 40, + "col": 14 + } + } }, { "start": { @@ -261,10 +411,30 @@ "kind": "Value", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 39, + "col": 8 + }, + "end": { + "line": 39, + "col": 11 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 37, + "col": 6 + }, + "end": { + "line": 37, + "col": 7 + } + } }, { "start": { @@ -279,7 +449,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 35, + "col": 4 + }, + "end": { + "line": 35, + "col": 6 + } + } }, { "start": { @@ -294,7 +474,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 33, + "col": 11 + }, + "end": { + "line": 33, + "col": 13 + } + } }, { "start": { @@ -309,7 +499,17 @@ "kind": "Class", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 31, + "col": 4 + }, + "end": { + "line": 31, + "col": 5 + } + } }, { "start": { @@ -324,7 +524,17 @@ "kind": "Class", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 29, + "col": 4 + }, + "end": { + "line": 29, + "col": 5 + } + } }, { "start": { @@ -339,7 +549,17 @@ "kind": "Class", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 27, + "col": 6 + }, + "end": { + "line": 27, + "col": 7 + } + } }, { "start": { @@ -367,7 +587,17 @@ "kind": "Label", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 25, + "col": 34 + }, + "end": { + "line": 25, + "col": 35 + } + } }, { "start": { @@ -382,7 +612,17 @@ "kind": "Label", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 25, + "col": 26 + }, + "end": { + "line": 25, + "col": 27 + } + } }, { "start": { @@ -397,10 +637,30 @@ "kind": "Label", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 25, + "col": 18 + }, + "end": { + "line": 25, + "col": 19 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 25, + "col": 8 + }, + "end": { + "line": 25, + "col": 13 + } + } }, { "start": { @@ -428,7 +688,17 @@ "kind": "Constructor", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 23, + "col": 38 + }, + "end": { + "line": 23, + "col": 44 + } + } }, { "start": { @@ -443,10 +713,30 @@ "kind": "Constructor", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 23, + "col": 24 + }, + "end": { + "line": 23, + "col": 29 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 23, + "col": 14 + }, + "end": { + "line": 23, + "col": 21 + } + } }, { "start": { @@ -461,7 +751,17 @@ "kind": "Exn", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 21, + "col": 10 + }, + "end": { + "line": 21, + "col": 12 + } + } }, { "start": { @@ -489,10 +789,30 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 18, + "col": 11 + }, + "end": { + "line": 18, + "col": 12 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 16, + "col": 6 + }, + "end": { + "line": 16, + "col": 13 + } + } }, { "start": { @@ -520,10 +840,30 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 13, + "col": 2 + }, + "end": { + "line": 13, + "col": 23 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 12, + "col": 11 + }, + "end": { + "line": 12, + "col": 23 + } + } }, { "start": { @@ -551,7 +891,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 9, + "col": 13 + }, + "end": { + "line": 9, + "col": 14 + } + } }, { "start": { @@ -579,7 +929,17 @@ "kind": "Value", "type": "t -> int", "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 6, + "col": 8 + }, + "end": { + "line": 6, + "col": 11 + } + } }, { "start": { @@ -594,10 +954,30 @@ "kind": "Type", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 4, + "col": 9 + }, + "end": { + "line": 4, + "col": 10 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 3, + "col": 14 + }, + "end": { + "line": 3, + "col": 16 + } + } }, { "start": { @@ -612,10 +992,30 @@ "kind": "Type", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 2, + "col": 7 + }, + "end": { + "line": 2, + "col": 8 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 1, + "col": 7 + }, + "end": { + "line": 1, + "col": 10 + } + } } ], "notifications": [] @@ -643,7 +1043,17 @@ "kind": "Value", "type": "< foo : int >", "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 56, + "col": 4 + }, + "end": { + "line": 56, + "col": 13 + } + } }, { "start": { @@ -658,7 +1068,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 54, + "col": 4 + }, + "end": { + "line": 54, + "col": 6 + } + } }, { "start": { @@ -686,10 +1106,30 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 51, + "col": 2 + }, + "end": { + "line": 51, + "col": 35 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 50, + "col": 11 + }, + "end": { + "line": 50, + "col": 13 + } + } }, { "start": { @@ -704,7 +1144,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 32, + "col": 4 + }, + "end": { + "line": 32, + "col": 6 + } + } }, { "start": { @@ -719,7 +1169,17 @@ "kind": "ClassType", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 30, + "col": 11 + }, + "end": { + "line": 30, + "col": 13 + } + } }, { "start": { @@ -747,7 +1207,17 @@ "kind": "Label", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 22, + "col": 34 + }, + "end": { + "line": 22, + "col": 35 + } + } }, { "start": { @@ -762,7 +1232,17 @@ "kind": "Label", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 22, + "col": 26 + }, + "end": { + "line": 22, + "col": 27 + } + } }, { "start": { @@ -777,10 +1257,30 @@ "kind": "Label", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 22, + "col": 18 + }, + "end": { + "line": 22, + "col": 19 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 22, + "col": 8 + }, + "end": { + "line": 22, + "col": 13 + } + } }, { "start": { @@ -808,7 +1308,17 @@ "kind": "Constructor", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 20, + "col": 38 + }, + "end": { + "line": 20, + "col": 44 + } + } }, { "start": { @@ -823,10 +1333,30 @@ "kind": "Constructor", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 20, + "col": 24 + }, + "end": { + "line": 20, + "col": 29 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 20, + "col": 14 + }, + "end": { + "line": 20, + "col": 21 + } + } }, { "start": { @@ -841,7 +1371,17 @@ "kind": "Exn", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 18, + "col": 10 + }, + "end": { + "line": 18, + "col": 12 + } + } }, { "start": { @@ -869,10 +1409,30 @@ "kind": "Method", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 11, + "col": 2 + }, + "end": { + "line": 11, + "col": 23 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 10, + "col": 11 + }, + "end": { + "line": 10, + "col": 23 + } + } }, { "start": { @@ -913,7 +1473,17 @@ "kind": "Value", "type": "t -> int", "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 6, + "col": 8 + }, + "end": { + "line": 6, + "col": 11 + } + } }, { "start": { @@ -928,10 +1498,30 @@ "kind": "Type", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 5, + "col": 9 + }, + "end": { + "line": 5, + "col": 10 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 4, + "col": 14 + }, + "end": { + "line": 4, + "col": 16 + } + } }, { "start": { @@ -946,10 +1536,30 @@ "kind": "Type", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 2, + "col": 7 + }, + "end": { + "line": 2, + "col": 8 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 1, + "col": 7 + }, + "end": { + "line": 1, + "col": 10 + } + } } ], "notifications": [] @@ -972,7 +1582,17 @@ "kind": "Value", "type": "A.a", "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 5, + "col": 4 + }, + "end": { + "line": 5, + "col": 5 + } + } }, { "start": { @@ -1000,10 +1620,30 @@ "kind": "Type", "type": null, "children": [], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 2, + "col": 7 + }, + "end": { + "line": 2, + "col": 8 + } + } } ], - "deprecated": false + "deprecated": false, + "selection": { + "start": { + "line": 1, + "col": 7 + }, + "end": { + "line": 1, + "col": 8 + } + } } ], "notifications": [] From 20c9b524504c7225d16d0ac331febc488853f7a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 23 Jun 2025 16:50:59 +0200 Subject: [PATCH 34/53] Add changelog entry for #1942 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index c803046e61..9d8068409f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -15,6 +15,8 @@ unreleased fixes #1913) - Downstreamed a typer fix from 5.3.X that would trigger assertions linked to scopes bit masks when backtracking the typer cache (#1935) + - Add a new selection field to outline results that contains the location of + the symbol itself. (#1942) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From 1bad866908014d97ca3742354dd18165fc428594 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 23 Jun 2025 16:53:18 +0200 Subject: [PATCH 35/53] CI: fix changelog action --- .github/workflows/changelog.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/changelog.yml b/.github/workflows/changelog.yml index 3106730237..d7da2f0b85 100644 --- a/.github/workflows/changelog.yml +++ b/.github/workflows/changelog.yml @@ -8,6 +8,6 @@ on: jobs: Changelog-Entry-Check: name: Check Changelog Action - runs-on: ubuntu-20.04 + runs-on: ubuntu-latest steps: - uses: tarides/changelog-check-action@v3 From 0cfe51a63334545dc9e5e62cfd983489b4b02562 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Jun 2025 10:42:52 +0200 Subject: [PATCH 36/53] Use full class fields locs in otuline --- src/analysis/outline.ml | 2 +- tests/test-dirs/outline.t/run.t | 34 ++++++++++++++++----------------- 2 files changed, 18 insertions(+), 18 deletions(-) diff --git a/src/analysis/outline.ml b/src/analysis/outline.ml index 2d2d170b6a..d64fb2e6ac 100644 --- a/src/analysis/outline.ml +++ b/src/analysis/outline.ml @@ -176,7 +176,7 @@ and get_class_elements node = { Query_protocol.outline_name = str_loc.Location.txt; outline_kind; outline_type = None; - location = str_loc.Location.loc; + location = cf.cf_loc; selection = str_loc.loc; children; deprecated diff --git a/tests/test-dirs/outline.t/run.t b/tests/test-dirs/outline.t/run.t index 490a3c402b..8070253602 100644 --- a/tests/test-dirs/outline.t/run.t +++ b/tests/test-dirs/outline.t/run.t @@ -32,11 +32,11 @@ { "start": { "line": 70, - "col": 13 + "col": 6 }, "end": { "line": 70, - "col": 16 + "col": 21 }, "name": "foo", "kind": "Method", @@ -172,11 +172,11 @@ { "start": { "line": 58, - "col": 11 + "col": 4 }, "end": { "line": 58, - "col": 14 + "col": 36 }, "name": "bar", "kind": "Method", @@ -197,11 +197,11 @@ { "start": { "line": 57, - "col": 8 + "col": 4 }, "end": { "line": 57, - "col": 11 + "col": 16 }, "name": "foo", "kind": "Value", @@ -248,10 +248,10 @@ { "start": { "line": 47, - "col": 8 + "col": 4 }, "end": { - "line": 47, + "line": 52, "col": 9 }, "name": "b", @@ -261,11 +261,11 @@ { "start": { "line": 49, - "col": 15 + "col": 8 }, "end": { - "line": 49, - "col": 25 + "line": 51, + "col": 32 }, "name": "inside_a_b", "kind": "Method", @@ -376,11 +376,11 @@ { "start": { "line": 40, - "col": 11 + "col": 4 }, "end": { "line": 40, - "col": 14 + "col": 39 }, "name": "bar", "kind": "Method", @@ -401,11 +401,11 @@ { "start": { "line": 39, - "col": 8 + "col": 4 }, "end": { "line": 39, - "col": 11 + "col": 16 }, "name": "foo", "kind": "Value", @@ -779,11 +779,11 @@ { "start": { "line": 18, - "col": 11 + "col": 4 }, "end": { "line": 18, - "col": 12 + "col": 22 }, "name": "b", "kind": "Method", From 5bd703ffb883cb376b89ac7c9039121f0e24d2c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Jun 2025 14:31:09 +0200 Subject: [PATCH 37/53] Add a test triggering the infinite loop. Reproducing issue #1489 --- tests/test-dirs/lsp-issue1489.t | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 tests/test-dirs/lsp-issue1489.t diff --git a/tests/test-dirs/lsp-issue1489.t b/tests/test-dirs/lsp-issue1489.t new file mode 100644 index 0000000000..ab099e741c --- /dev/null +++ b/tests/test-dirs/lsp-issue1489.t @@ -0,0 +1,8 @@ + $ cat >repro.ml <<'EOF' + > type t = ( :: ) + > let f (x: t) = x + > EOF + +FIXME: this should not hang and return a matching. +$ $MERLIN single case-analysis -start 2:16 -end 2:17 \ +> -filename repro.ml Date: Tue, 24 Jun 2025 14:32:23 +0200 Subject: [PATCH 38/53] Pprintast hangs when printing some patterns with the `(::)` constructor. Fixes ocaml/ocaml-lsp#1489 --- src/ocaml/parsing/pprintast.ml | 39 +++++++++++++-------------------- tests/test-dirs/lsp-issue1489.t | 23 ++++++++++++++++--- 2 files changed, 35 insertions(+), 27 deletions(-) diff --git a/src/ocaml/parsing/pprintast.ml b/src/ocaml/parsing/pprintast.ml index 9a1b9bd9a4..29c997cbf0 100644 --- a/src/ocaml/parsing/pprintast.ml +++ b/src/ocaml/parsing/pprintast.ml @@ -548,37 +548,28 @@ and pattern_or ctxt f x = pp f "@[%a@]" (list ~sep:"@ | " (pattern1 ctxt)) orpats and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit = - let rec pattern_list_helper f = function - | {ppat_desc = - Ppat_construct - ({ txt = Lident("::") ;_}, - Some ([], {ppat_desc = Ppat_tuple([pat1; pat2]);_})); - ppat_attributes = []} - - -> - pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*) - | p -> pattern1 ctxt f p - in if x.ppat_attributes <> [] then pattern ctxt f x else match x.ppat_desc with | Ppat_variant (l, Some p) -> pp f "@[<2>`%a@;%a@]" ident_of_name l (simple_pattern ctxt) p | Ppat_construct (({txt=Lident("()"|"[]"|"true"|"false");_}), _) -> simple_pattern ctxt f x - | Ppat_construct (({txt;_} as li), po) -> + | Ppat_construct ( + {txt=Lident("::");_}, + Some ([], {ppat_desc = Ppat_tuple([pat1; pat2]);_})) + when x.ppat_attributes = [] -> + pp f "%a::%a" (simple_pattern ctxt) pat1 (pattern1 ctxt) pat2 (*RA*) + | Ppat_construct (li, po) -> (* FIXME The third field always false *) - if txt = Lident "::" then - pp f "%a" pattern_list_helper x - else - (match po with - | Some ([], x) -> - (* [true] and [false] are handled above *) - pp f "%a@;%a" value_longident_loc li (simple_pattern ctxt) x - | Some (vl, x) -> - pp f "%a@ (type %a)@;%a" value_longident_loc li - (list ~sep:"@ " ident_of_name_loc) vl - (simple_pattern ctxt) x - | None -> pp f "%a" value_longident_loc li) + (match po with + | Some ([], x) -> + (* [true] and [false] are handled above *) + pp f "%a@;%a" value_longident_loc li (simple_pattern ctxt) x + | Some (vl, x) -> + pp f "%a@ (type %a)@;%a" value_longident_loc li + (list ~sep:"@ " ident_of_name_loc) vl + (simple_pattern ctxt) x + | None -> pp f "%a" value_longident_loc li) | _ -> simple_pattern ctxt f x and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit = diff --git a/tests/test-dirs/lsp-issue1489.t b/tests/test-dirs/lsp-issue1489.t index ab099e741c..03c4d082e1 100644 --- a/tests/test-dirs/lsp-issue1489.t +++ b/tests/test-dirs/lsp-issue1489.t @@ -3,6 +3,23 @@ > let f (x: t) = x > EOF -FIXME: this should not hang and return a matching. -$ $MERLIN single case-analysis -start 2:16 -end 2:17 \ -> -filename repro.ml -filename repro.ml _" + ], + "notifications": [] + } From 4cf798b920ee29e834787fb94c08ab376c79de9c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Jun 2025 14:39:45 +0200 Subject: [PATCH 39/53] Add changelog entry for #1944 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 9d8068409f..679c421a94 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,8 @@ unreleased to scopes bit masks when backtracking the typer cache (#1935) - Add a new selection field to outline results that contains the location of the symbol itself. (#1942) + - Fix destruct hanging when printing patterns with (::). (#1944, fixes + ocaml/ocaml-lsp#1489) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From ca67e835b5b8cd6f735fffc1149292dbc881b0c1 Mon Sep 17 00:00:00 2001 From: Brian Ward Date: Mon, 31 Mar 2025 12:09:53 -0400 Subject: [PATCH 40/53] Add test showing issue --- tests/test-dirs/locate/issue1915.t | 58 ++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 tests/test-dirs/locate/issue1915.t diff --git a/tests/test-dirs/locate/issue1915.t b/tests/test-dirs/locate/issue1915.t new file mode 100644 index 0000000000..f5481290fa --- /dev/null +++ b/tests/test-dirs/locate/issue1915.t @@ -0,0 +1,58 @@ +Testing the behavior of custom operators + + $ cat >main.ml < let ( := ) v a = Printf.printf "%s = %d;\n" v a + > let () = "foo" := 3 + > let () = ( := ) "foo" 3 + > EOF + + $ $MERLIN single locate -look-for ml -position 2:17 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not a valid identifier" + + $ $MERLIN single locate -look-for ml -position 3:12 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not a valid identifier" + +Testing custom indexing operators + + $ cat >main.ml < let (.%{;..}) a k = Printf.printf "%s.coeffRef(%d);\n" a k.(0) + > let (.%{ }) a k = Printf.printf "%s.coeffRef(%d);\n" a k + > let name = "baz" + > let () = name.%{2;4} + > let () = name.%{5} + > let () = ( .%{ } ) name 3 + > EOF + + $ $MERLIN single locate -look-for ml -position 4:15 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not in environment '%'" + + $ $MERLIN single locate -look-for ml -position 4:16 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not a valid identifier" + + $ $MERLIN single locate -look-for ml -position 5:15 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not in environment '%'" + + $ $MERLIN single locate -look-for ml -position 5:15 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not in environment '%'" + + $ $MERLIN single locate -look-for ml -position 5:16 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not a valid identifier" + + $ $MERLIN single locate -look-for ml -position 6:13 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not in environment '%'" + + $ $MERLIN single locate -look-for ml -position 6:14 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not a valid identifier" + + $ $MERLIN single locate -look-for ml -position 6:15 \ + > -filename ./main.ml < ./main.ml | jq '.value' + "Not a valid identifier" From 9bf7878582e85bfeb789ad324278d423f4b4360c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 2 May 2025 14:16:09 +0200 Subject: [PATCH 41/53] Add a reproduction case for #1580 and #1588 --- tests/test-dirs/locate/ill-typed/issue1580.t | 79 ++++++++++++++++++++ 1 file changed, 79 insertions(+) create mode 100644 tests/test-dirs/locate/ill-typed/issue1580.t diff --git a/tests/test-dirs/locate/ill-typed/issue1580.t b/tests/test-dirs/locate/ill-typed/issue1580.t new file mode 100644 index 0000000000..0d9762753c --- /dev/null +++ b/tests/test-dirs/locate/ill-typed/issue1580.t @@ -0,0 +1,79 @@ +Issue #1580: + + $ cat >test.ml << 'EOF' + > module type S = sig + > val foo : unit -> ('a -> 'a -> bool) -> unit + > end + > + > module F (M : S) = struct + > let z () = M.foo () compare + > end + > EOF + + $ $MERLIN single errors -filename test.ml 'a -> int + but an expression was expected of type 'a -> 'a -> bool + Type int is not compatible with type bool" + } + ], + "notifications": [] + } + +FIXME: the typing recovery would be improved for Merlin to perform the correct +jump here: + + $ $MERLIN single locate -position 6:16 \ + > -filename test.ml test.ml <<'EOF' + > let test ~f:(_ : unit -> unit) = () + > type t = F : { f : unit -> 'fn } -> t + > let call (F { f }) = test ~f + > EOF + + $ $MERLIN single locate -position 3:23 \ + > -filename test.ml $fn but an expression was expected of type + unit -> unit + Type $fn is not compatible with type unit + Hint: $fn is an existential type bound by the constructor F." + } + ], + "notifications": [] + } From 135b0acef438c6398396cc9ba6198118153f552c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 22 May 2023 15:02:27 +0200 Subject: [PATCH 42/53] Add a test illustrating issue #1610 --- tests/test-dirs/locate/issue1610.t | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 tests/test-dirs/locate/issue1610.t diff --git a/tests/test-dirs/locate/issue1610.t b/tests/test-dirs/locate/issue1610.t new file mode 100644 index 0000000000..453fdd882a --- /dev/null +++ b/tests/test-dirs/locate/issue1610.t @@ -0,0 +1,24 @@ + $ cat >main.ml < module type T = sig + > type 'a t + > end + > + > module M (T : T) = struct + > type t = int T.t + > end + > + > module T = struct type 'a t end + > + > type t = M(T).t + > EOF + +FIXME: we should jump to the functor's body, not the current definition + $ $MERLIN single locate -look-for ml -position 11:15 \ + > -filename main.ml Date: Fri, 2 May 2025 14:45:03 +0200 Subject: [PATCH 43/53] Add a test illustrating issue ocaml/merlin#1610 --- tests/test-dirs/locate/issue1610.t | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/tests/test-dirs/locate/issue1610.t b/tests/test-dirs/locate/issue1610.t index 453fdd882a..4184082626 100644 --- a/tests/test-dirs/locate/issue1610.t +++ b/tests/test-dirs/locate/issue1610.t @@ -19,6 +19,9 @@ FIXME: we should jump to the functor's body, not the current definition "file": "$TESTCASE_ROOT/main.ml", "pos": { "line": 11, - "col": 0 + "col": 5 } } + +The issue appears to reside in "reconstruct identifier". +A fix was attempted in https://github.com/ocaml/merlin/pull/1611. From 78695a68551dbe4bc1cb66d2627b076e316389f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Fri, 2 May 2025 15:56:07 +0200 Subject: [PATCH 44/53] Illustrate issue #1595 --- tests/test-dirs/config/copy-issue.t | 36 +++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) create mode 100644 tests/test-dirs/config/copy-issue.t diff --git a/tests/test-dirs/config/copy-issue.t b/tests/test-dirs/config/copy-issue.t new file mode 100644 index 0000000000..d44e68810e --- /dev/null +++ b/tests/test-dirs/config/copy-issue.t @@ -0,0 +1,36 @@ + $ cat >dune-project <<'EOF' + > (lang dune 3.0) + > EOF + + $ mkdir dep + $ cat >dep/dep.ml <<'EOF' + > let txt = "Hello!" + > EOF + + $ mkdir exe + $ cat >exe/main.ml << 'EOF' + > print_endline Dep.txt + > EOF + + $ cat >exe/dune << 'EOF' + > (executable + > (name main)) + > (copy_files# %{project_root}/dep/*.ml) + > EOF + + $ dune exec ./exe/main.exe + Hello! + + $ $MERLIN single errors -filename exe/main.ml Date: Fri, 2 May 2025 17:44:03 +0200 Subject: [PATCH 45/53] Add a recovery layer around type_argument. Fixes ocaml/merlin#1580 and ocaml/merlin#1588 --- src/ocaml/typing/typecore.ml | 32 ++++++++++++++++++- tests/test-dirs/locate/ill-typed/issue1580.t | 30 ++++++++++++++--- .../locate/ill-typed/locate-non-fun.t | 16 +++++++--- 3 files changed, 68 insertions(+), 10 deletions(-) diff --git a/src/ocaml/typing/typecore.ml b/src/ocaml/typing/typecore.ml index 06e56fbe34..237363f4aa 100644 --- a/src/ocaml/typing/typecore.ml +++ b/src/ocaml/typing/typecore.ml @@ -5409,7 +5409,7 @@ and type_label_exp create env loc ty_expected if is_poly then check_univars env "field value" arg label.lbl_arg vars; (lid, label, {arg with exp_type = instance arg.exp_type}) -and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected = +and type_argument_ ?explanation ?recarg env sarg ty_expected' ty_expected = (* ty_expected' may be generic *) let no_labels ty = let ls, tvar = list_labels env ty in @@ -5525,6 +5525,36 @@ and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected = unify_exp ~sexp:sarg env texp ty_expected; texp +and type_argument ?explanation ?recarg env sarg ty_expected' ty_expected = + Msupport.with_saved_types + ~warning_attribute:sarg.pexp_attributes ?save_part:None + (fun () -> + let saved = save_levels () in + try + type_argument_ ?explanation ?recarg env sarg ty_expected' ty_expected + with exn -> + Msupport.erroneous_type_register ty_expected; + raise_error exn; + set_levels saved; + let loc = sarg.pexp_loc in + { + exp_desc = Texp_ident + (Path.Pident (Ident.create_local "*type-error*"), + Location.mkloc (Longident.Lident "*type-error*") loc, + { Types. + val_type = ty_expected; + val_kind = Val_reg; + val_loc = loc; + val_attributes = []; + val_uid = Uid.internal_not_actually_unique; + }); + exp_loc = loc; + exp_extra = []; + exp_type = ty_expected; + exp_env = env; + exp_attributes = Msupport.recovery_attributes sarg.pexp_attributes; + }) + and type_application env funct sargs = (* funct.exp_type may be generic *) let result_type omitted ty_fun = diff --git a/tests/test-dirs/locate/ill-typed/issue1580.t b/tests/test-dirs/locate/ill-typed/issue1580.t index 0d9762753c..7c0d2d0d69 100644 --- a/tests/test-dirs/locate/ill-typed/issue1580.t +++ b/tests/test-dirs/locate/ill-typed/issue1580.t @@ -34,12 +34,28 @@ Issue #1580: "notifications": [] } -FIXME: the typing recovery would be improved for Merlin to perform the correct -jump here: +The typing recovery allows Merlin to perform the correct jump here: $ $MERLIN single locate -position 6:16 \ > -filename test.ml -filename test.ml -filename test.ml int -> bool but an expression was expected of type Float.t -> Float.t -> bool Type int is not compatible with type Float.t = float" + "message": "This expression has type Float.t list but an expression was expected of type unit" } Merlin is still able to inspect part of the ill-typed tree @@ -55,7 +55,13 @@ Merlin is still able to inspect part of the ill-typed tree "tail": "no" } -FIXME: And locate should as well... +And locate should as well... $ $MERLIN single locate -position 15:70 \ > -filename ill.ml Date: Tue, 6 May 2025 15:31:34 +0200 Subject: [PATCH 46/53] Add a test illustration issue #1929 --- src/analysis/test.ml | 10 ++++++++++ tests/test-dirs/locate/issue1929.t | 31 ++++++++++++++++++++++++++++++ 2 files changed, 41 insertions(+) create mode 100644 src/analysis/test.ml create mode 100644 tests/test-dirs/locate/issue1929.t diff --git a/src/analysis/test.ml b/src/analysis/test.ml new file mode 100644 index 0000000000..e8b0cbc040 --- /dev/null +++ b/src/analysis/test.ml @@ -0,0 +1,10 @@ +module Foo = struct + type t = { foo : int; bar : int } + + let foo = "hello" +end + +let _ = + let foo = 10 in + let bar = 10 in + ({ Foo.foo; bar } : Foo.t) diff --git a/tests/test-dirs/locate/issue1929.t b/tests/test-dirs/locate/issue1929.t new file mode 100644 index 0000000000..51189e714c --- /dev/null +++ b/tests/test-dirs/locate/issue1929.t @@ -0,0 +1,31 @@ + $ cat >test.ml <<'EOF' + > module Foo = struct + > type t = + > { foo : int + > ; bar : int + > } + > + > let foo = "hello" + > end + > + > let _ = + > let foo = 10 in + > let bar = 10 in + > ({ Foo.foo; bar } : Foo.t) + > ;; + > EOF + +FIXME: this answer is wrong. The correct value jumping to `foo` line 11 + $ $MERLIN single locate -position 13:10 \ + > -filename test.ml Date: Tue, 20 May 2025 15:02:36 +0200 Subject: [PATCH 47/53] Add a test illustrating #1924 and #1821 --- tests/test-dirs/locate/dune-pp.t | 55 ++++++++++++++++++++++++++++++++ 1 file changed, 55 insertions(+) create mode 100644 tests/test-dirs/locate/dune-pp.t diff --git a/tests/test-dirs/locate/dune-pp.t b/tests/test-dirs/locate/dune-pp.t new file mode 100644 index 0000000000..67f079ce56 --- /dev/null +++ b/tests/test-dirs/locate/dune-pp.t @@ -0,0 +1,55 @@ +This test reproduces the issue described in: +https://github.com/ocaml/merlin/issues/1934 + + + $ cat >dune-project < (lang dune 2.0) + > EOF + + $ mkdir lib + $ cat >lib/lib.ml < let message = "hello" + > EOF + $ cat >lib/dune < (library + > (name lib) + > (preprocess (action (run sed "s/hello/world/g" %{input-file})))) + > EOF + + $ mkdir lib2 + $ cat >lib2/lib.ml < let message = "hello" + > EOF + $ cat >lib2/dune < (library + > (name lib2) + > (preprocess (action (run sed "s/hello/world/g" %{input-file})))) + > EOF + + + $ cat >main.ml < module M = Lib + > let () = print_endline M.message + > EOF + + $ cat >dune < (executable + > (name main) + > (libraries lib lib2)) + > EOF + + $ $DUNE exec ./main.exe + world + + $ ls _build/default/lib/*.ml + _build/default/lib/lib.ml + _build/default/lib/lib.pp.ml + +FIXME Merlin should treat Dune's .pp. files in a correct, ad-hoc way. Right it +appears that the digest of the original source file is not generated properly. + $ $MERLIN single locate -look-for ml -position 1:12 -filename main.ml Date: Mon, 23 Jun 2025 11:02:00 +0200 Subject: [PATCH 48/53] Disable all locate test on windows since they almost always print paths. --- tests/test-dirs/locate/dune | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/tests/test-dirs/locate/dune b/tests/test-dirs/locate/dune index 3121931a35..5ae54f242b 100755 --- a/tests/test-dirs/locate/dune +++ b/tests/test-dirs/locate/dune @@ -1,8 +1,5 @@ (cram - (applies_to looping-substitution mutually-recursive partial-cmt includes - issue802 issue845 issue1848 issue1199 issue1524 sig-substs l-413-features - module-aliases locate-constrs without-implem without-sig module-decl-aliases - in-implicit-trans-dep distinguish-files) + (applies_to :whole_subtree) (enabled_if (<> %{os_type} Win32))) From 75634b466eabfbadbd12bdbd92d551853fa4e170 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 23 Jun 2025 16:01:04 +0200 Subject: [PATCH 49/53] Workaround dune usage of BUILD_PREFIX_MAP to rewrite paths in locate heuristics. --- src/analysis/locate.ml | 37 ++++++++++++++++++++++++++------ tests/test-dirs/locate/dune-pp.t | 14 +++++++++--- 2 files changed, 42 insertions(+), 9 deletions(-) diff --git a/src/analysis/locate.ml b/src/analysis/locate.ml index 51967b5f45..6aeb10c730 100644 --- a/src/analysis/locate.ml +++ b/src/analysis/locate.ml @@ -294,7 +294,23 @@ module Utils = struct | CMT _ | CMTI _ -> Mconfig.cmt_path config end -let move_to filename cmt_infos = +let reroot_build_dir ~root path = + let sep = + try String.get Filename.dir_sep 0 with Invalid_argument _ -> '/' + in + let segments = path |> String.split_on_char ~sep in + let rec strip_prefix = function + | [] -> [] + | "_build" :: _ as l -> l + | _ :: tl -> strip_prefix tl + in + match strip_prefix segments with + | [] -> path + | l -> + let sep = Printf.sprintf "%c" sep in + Filename.concat root (String.concat ~sep l) + +let move_to (config : Mconfig.t) filename cmt_infos = let digest = (* [None] only for packs, and we wouldn't have a trie if the cmt was for a pack. *) @@ -302,6 +318,14 @@ let move_to filename cmt_infos = Filename.concat cmt_infos.Cmt_format.cmt_builddir (Option.get cmt_infos.cmt_sourcefile) in + let sourcefile_in_builddir = + (* This workaround is meant to fix issues with Dune's BUILD_PREFIX_MAP It + will not work when the [_build] folder is not located at the source + root. See [#1934](https://github.com/ocaml/merlin/issues/1934). *) + match config.merlin.source_root with + | None -> sourcefile_in_builddir + | Some root -> reroot_build_dir ~root sourcefile_in_builddir + in match sourcefile_in_builddir |> String.split_on_char ~sep:'.' |> List.rev with @@ -332,7 +356,7 @@ let load_cmt ~config ?(with_fallback = true) comp_unit = let cmt_infos = (Cmt_cache.read path).cmt_infos in let source_file = cmt_infos.cmt_sourcefile in let source_file = Option.value ~default:"*pack*" source_file in - move_to path cmt_infos; + move_to config.mconfig path cmt_infos; Ok (source_file, cmt_infos) | None -> Error () @@ -622,13 +646,14 @@ let find_loc_of_comp_unit ~config uid comp_unit = let find_loc_of_uid ~config ~local_defs ?ident ?fallback (uid : Shape.Uid.t) = let find_loc_of_item ~comp_unit = - match find_loc_of_item ~config ~local_defs uid comp_unit, fallback, ident with + match + (find_loc_of_item ~config ~local_defs uid comp_unit, fallback, ident) + with | Some { loc; txt }, _, Some ident when String.equal txt ident -> (* Checking the ident prevent returning nonsensical results when some uid were swaped but the cmt files were not rebuilt. *) Some (uid, loc) - | Some { loc; _ }, _, None -> - Some (uid, loc) + | Some { loc; _ }, _, None -> Some (uid, loc) | (Some _ | None), Some fallback, _ -> find_loc_of_item ~config ~local_defs fallback comp_unit |> Option.map ~f:(fun { Location.loc; _ } -> (fallback, loc)) @@ -672,7 +697,7 @@ let find_definition_uid ~config ~env ~(decl : Env_lookup.item) path = ~with_fallback:false unit_name with | Ok (filename, cmt_infos) -> - move_to filename cmt_infos; + move_to config.mconfig filename cmt_infos; log ~title:"read_unit_shape" "shapes loaded for %s" unit_name; cmt_infos.cmt_impl_shape | Error () -> diff --git a/tests/test-dirs/locate/dune-pp.t b/tests/test-dirs/locate/dune-pp.t index 67f079ce56..ca6af76eb2 100644 --- a/tests/test-dirs/locate/dune-pp.t +++ b/tests/test-dirs/locate/dune-pp.t @@ -45,11 +45,19 @@ https://github.com/ocaml/merlin/issues/1934 _build/default/lib/lib.ml _build/default/lib/lib.pp.ml -FIXME Merlin should treat Dune's .pp. files in a correct, ad-hoc way. Right it +Merlin should treat Dune's .pp. files in a correct, ad-hoc way. Right it appears that the digest of the original source file is not generated properly. - $ $MERLIN single locate -look-for ml -position 1:12 -filename main.ml Date: Tue, 24 Jun 2025 15:21:33 +0200 Subject: [PATCH 50/53] Add a changelog entry for #1930 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 679c421a94..848c020372 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,6 +19,8 @@ unreleased the symbol itself. (#1942) - Fix destruct hanging when printing patterns with (::). (#1944, fixes ocaml/ocaml-lsp#1489) + - Reproduce and fix a handful of jump-to-definition (locate) issues (#1930, + fixes #1580 and #1588, workaround for #1934) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) From e9e5fbf60c1c6be0d46657893d0da7547a411c3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Jun 2025 15:30:02 +0200 Subject: [PATCH 51/53] Don't override BUILD_PATH_PREFIX_MAP in the tests --- tests/test-dirs/pp/dot-pp-dot-ml-dune.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/test-dirs/pp/dot-pp-dot-ml-dune.t b/tests/test-dirs/pp/dot-pp-dot-ml-dune.t index 952a180bac..0d21e1fe5e 100644 --- a/tests/test-dirs/pp/dot-pp-dot-ml-dune.t +++ b/tests/test-dirs/pp/dot-pp-dot-ml-dune.t @@ -68,7 +68,7 @@ Then our test files: Now build with dune: - $ BUILD_PATH_PREFIX_MAP= dune build 2>/dev/null + $ dune build 2>/dev/null And confirm that locate works on both deps: From bc154c135a17962699cf816e47e342781a28dd28 Mon Sep 17 00:00:00 2001 From: Ulysse <5031221+voodoos@users.noreply.github.com> Date: Tue, 24 Jun 2025 15:57:39 +0200 Subject: [PATCH 52/53] Prepare release 5.5-503 (#1945) --- CHANGES.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index 848c020372..b6b35b77a7 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,6 @@ -unreleased +merlin 5.5 ========== +Tue Jun 24 16:10:42 CEST 2025 + merlin library - Expose utilities to manipulate typed-holes in `Merlin_analysis.Typed_hole` From 04f0d45ce118c076c5b37a9d129dcc36a6511147 Mon Sep 17 00:00:00 2001 From: Carine Morel Date: Tue, 11 Mar 2025 17:05:50 +0100 Subject: [PATCH 53/53] Moving computation of pipeline in new_commands.ml. Add a lot of TODO. --- src/commands/new_commands.ml | 115 ++++------------------------------- src/utils/shared.mli | 2 - 2 files changed, 13 insertions(+), 104 deletions(-) diff --git a/src/commands/new_commands.ml b/src/commands/new_commands.ml index 5745c45334..9159d1b31e 100644 --- a/src/commands/new_commands.ml +++ b/src/commands/new_commands.ml @@ -685,121 +685,37 @@ let all_commands = ~spec: [ arg "-start" " Where inlay-hints generation start" (marg_position - (fun - start - ( _start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ) - -> - ( start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ))); + (fun start (_start, stop, let_binding, pattern_binding, ghost) -> + (start, stop, let_binding, pattern_binding, ghost))); arg "-end" " Where inlay-hints generation stop" (marg_position - (fun - stop - ( start, - _stop, - let_binding, - pattern_binding, - function_params, - ghost ) - -> - ( start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ))); + (fun stop (start, _stop, let_binding, pattern_binding, ghost) -> + (start, stop, let_binding, pattern_binding, ghost))); optional "-let-binding" " Hint let-binding (default is false)" (Marg.bool (fun let_binding - ( start, - stop, - _let_binding, - pattern_binding, - function_params, - ghost ) - -> - ( start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ))); + (start, stop, _let_binding, pattern_binding, ghost) + -> (start, stop, let_binding, pattern_binding, ghost))); optional "-pattern-binding" " Hint pattern-binding (default is false)" (Marg.bool (fun pattern_binding - ( start, - stop, - let_binding, - _pattern_binding, - function_params, - ghost ) - -> - ( start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ))); - optional "-function-params" - " Hint function parameters (default is false)" - (Marg.bool - (fun - function_params - ( start, - stop, - let_binding, - pattern_binding, - _function_params, - ghost ) - -> - ( start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ))); + (start, stop, let_binding, _pattern_binding, ghost) + -> (start, stop, let_binding, pattern_binding, ghost))); optional "-avoid-ghost-location" " Avoid hinting ghost location (default is true)" (Marg.bool - (fun - ghost - ( start, - stop, - let_binding, - pattern_binding, - function_params, - _ghost ) - -> - ( start, - stop, - let_binding, - pattern_binding, - function_params, - ghost ))) + (fun ghost (start, stop, let_binding, pattern_binding, _ghost) -> + (start, stop, let_binding, pattern_binding, ghost))) ] - ~default:(`None, `None, false, false, false, true) + ~default:(`None, `None, false, false, true) begin fun shared config source - ( start, - stop, - let_binding, - pattern_binding, - function_params, - avoid_ghost ) + (start, stop, let_binding, pattern_binding, avoid_ghost) -> match (start, stop) with | `None, `None -> failwith "-start and -end are mandatory" @@ -810,12 +726,7 @@ let all_commands = let position = Msource.get_position source stop in run ~position shared config source (Query_protocol.Inlay_hints - ( start, - stop, - let_binding, - pattern_binding, - function_params, - avoid_ghost )) + (start, stop, let_binding, pattern_binding, avoid_ghost)) end; command "shape" ~doc: diff --git a/src/utils/shared.mli b/src/utils/shared.mli index 5945a208f9..b2aa9bfcd3 100644 --- a/src/utils/shared.mli +++ b/src/utils/shared.mli @@ -7,5 +7,3 @@ val create : 'a -> 'a t val protect : 'a t -> (unit -> 'b) -> 'b val signal : 'a t -> unit val wait : 'a t -> unit -val lock : 'a t -> unit -val unlock : 'a t -> unit