From a687b1529f08ccb1a47f239904dc0fb4bce0adfd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 2 May 2024 16:29:16 +0200 Subject: [PATCH 1/3] test: show issue with paths that need parens / spaces --- tests/test-dirs/type-enclosing/need-parens.t | 54 ++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 tests/test-dirs/type-enclosing/need-parens.t diff --git a/tests/test-dirs/type-enclosing/need-parens.t b/tests/test-dirs/type-enclosing/need-parens.t new file mode 100644 index 0000000000..4bc390f0a5 --- /dev/null +++ b/tests/test-dirs/type-enclosing/need-parens.t @@ -0,0 +1,54 @@ +FIXME: locate on `M.(|+)` should work: + $ $MERLIN single locate -position 2:11 -filename test.ml <<'EOF' | \ + > jq '.value' + > module M = struct let (+) a b = a + b end + > let _ = M.(+) + > EOF + "Not in environment 'M.+'" + +Locate on `M.(+|)` should work: + $ $MERLIN single locate -position 2:12 -filename test.ml <<'EOF' | \ + > jq '.value' + > module M = struct let (+) a b = a + b end + > let _ = M.(+) + > EOF + { + "file": "test.ml", + "pos": { + "line": 1, + "col": 22 + } + } + +And need spaces: +FIXME: locate on `M.(| * )` should work: + $ $MERLIN single locate -position 2:11 -filename test.ml <<'EOF' | \ + > jq '.value' + > module M = struct let ( * ) a b = a + b end + > let _ = M.( * ) + > EOF + { + "file": "test.ml", + "pos": { + "line": 1, + "col": 0 + } + } + +And need spaces: +FIXME: locate on `M.( |* )` should work: + $ $MERLIN single locate -position 2:12 -filename test.ml <<'EOF' | \ + > jq '.value' + > module M = struct let ( * ) a b = a + b end + > let _ = M.( * ) + > EOF + "Comment not terminated" + +And need spaces: +FIXME: locate on `M.( *| )` should work: + $ $MERLIN single locate -position 2:13 -filename test.ml <<'EOF' | \ + > jq '.value' + > module M = struct let ( * ) a b = a + b end + > let _ = M.( * ) + > EOF + "Comment not terminated" From ab56eea0d17cf8eeb6546546a4b4e438c220586e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 2 May 2024 16:14:01 +0200 Subject: [PATCH 2/3] Make reconstruct identifier more robust It's always correct to have a space after the parenthesis and it is sometimes necessary, for infix operators that start with `*` for example. --- src/frontend/query_commands.ml | 6 +++--- tests/test-dirs/type-enclosing/need-parens.t | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/frontend/query_commands.ml b/src/frontend/query_commands.ml index ce64da921e..350d3e7586 100644 --- a/src/frontend/query_commands.ml +++ b/src/frontend/query_commands.ml @@ -221,7 +221,7 @@ let reconstruct_identifier pipeline pos = function (dot.[0] >= 'a' && dot.[0] <= 'z') || (dot.[0] >= 'A' && dot.[0] <= 'Z') then dot - else "(" ^ dot ^ ")" + else "( " ^ dot ^ ")" in begin match path with | [] -> [] @@ -507,9 +507,9 @@ let dispatch pipeline (type a) : a Query_protocol.t -> a = let typer = Mpipeline.typer_result pipeline in let pos = Mpipeline.get_lexing_pos pipeline pos in let node = Mtyper.node_at typer pos in - let res = Syntax_doc.get_syntax_doc pos node in + let res = Syntax_doc.get_syntax_doc pos node in (match res with - | Some res -> `Found res + | Some res -> `Found res | None -> `No_documentation) | Locate (patho, ml_or_mli, pos) -> diff --git a/tests/test-dirs/type-enclosing/need-parens.t b/tests/test-dirs/type-enclosing/need-parens.t index 4bc390f0a5..42a2927765 100644 --- a/tests/test-dirs/type-enclosing/need-parens.t +++ b/tests/test-dirs/type-enclosing/need-parens.t @@ -42,7 +42,7 @@ FIXME: locate on `M.( |* )` should work: > module M = struct let ( * ) a b = a + b end > let _ = M.( * ) > EOF - "Comment not terminated" + "Not in environment 'M.*'" And need spaces: FIXME: locate on `M.( *| )` should work: @@ -51,4 +51,4 @@ FIXME: locate on `M.( *| )` should work: > module M = struct let ( * ) a b = a + b end > let _ = M.( * ) > EOF - "Comment not terminated" + "Not in environment 'M.*'" From 9f8cbf4480fb88155d8976436d44fbd8909d43a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Thu, 2 May 2024 16:27:44 +0200 Subject: [PATCH 3/3] context: improve cursor position detection --- CHANGES.md | 1 + src/analysis/context.ml | 14 +++++++-- src/ocaml/parsing/pprintast.mli | 1 + tests/test-dirs/type-enclosing/need-parens.t | 32 +++++++++++++++----- 4 files changed, 39 insertions(+), 9 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 9576044ae7..ea217dc137 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ merlin NEXT_VERSION fixes #1661) - Ignore SIGPIPE in the Merlin server process (#1746) - Fix lexing of quoted strings in comments (#1754, fixes #1753) + - Improve cursor position detection in longidents (#1756) merlin 4.14 =========== diff --git a/src/analysis/context.ml b/src/analysis/context.ml index 30806301c0..7fba149868 100644 --- a/src/analysis/context.ml +++ b/src/analysis/context.ml @@ -64,8 +64,17 @@ let cursor_on_longident_end match lid with | Longident.Lident _ -> true | _ -> - let end_offset = loc.loc_end.pos_cnum in - let cstr_name_size = String.length name in + let end_offset = + loc.loc_end.pos_cnum in + let cstr_name_size = + (* FIXME: this is britle, but lids don't have precise enough location + information to handle these cases correctly. *) + let name_lenght = String.length name in + if Pprintast.needs_parens name then + name_lenght + 2 + else + name_lenght + in let constr_pos = { loc.loc_end with pos_cnum = end_offset - cstr_name_size } @@ -107,6 +116,7 @@ let inspect_expression ~cursor ~lid e : t = else Module_path | Texp_ident (p, lid_loc, _) -> let name = Path.last p in + log ~title:"inspect_context" "name is: [%s]" name; if name = "*type-error*" then (* For type_enclosing: it is enough to return Module_path here. - If the cursor was on the end of the lid typing should fail anyway diff --git a/src/ocaml/parsing/pprintast.mli b/src/ocaml/parsing/pprintast.mli index 4ceb5bbbb9..c9f5393dc2 100644 --- a/src/ocaml/parsing/pprintast.mli +++ b/src/ocaml/parsing/pprintast.mli @@ -57,3 +57,4 @@ val tyvar: Format.formatter -> string -> unit (* merlin *) val case_list : Format.formatter -> Parsetree.case list -> unit val protect_ident : Format.formatter -> string -> unit +val needs_parens : string -> bool diff --git a/tests/test-dirs/type-enclosing/need-parens.t b/tests/test-dirs/type-enclosing/need-parens.t index 42a2927765..9e7d310097 100644 --- a/tests/test-dirs/type-enclosing/need-parens.t +++ b/tests/test-dirs/type-enclosing/need-parens.t @@ -1,10 +1,16 @@ -FIXME: locate on `M.(|+)` should work: +Locate on `M.(|+)` should work: $ $MERLIN single locate -position 2:11 -filename test.ml <<'EOF' | \ > jq '.value' > module M = struct let (+) a b = a + b end > let _ = M.(+) > EOF - "Not in environment 'M.+'" + { + "file": "test.ml", + "pos": { + "line": 1, + "col": 22 + } + } Locate on `M.(+|)` should work: $ $MERLIN single locate -position 2:12 -filename test.ml <<'EOF' | \ @@ -21,7 +27,7 @@ Locate on `M.(+|)` should work: } And need spaces: -FIXME: locate on `M.(| * )` should work: +Locate on `M.(| * )` should work: $ $MERLIN single locate -position 2:11 -filename test.ml <<'EOF' | \ > jq '.value' > module M = struct let ( * ) a b = a + b end @@ -36,19 +42,31 @@ FIXME: locate on `M.(| * )` should work: } And need spaces: -FIXME: locate on `M.( |* )` should work: +Locate on `M.( |* )` should work: $ $MERLIN single locate -position 2:12 -filename test.ml <<'EOF' | \ > jq '.value' > module M = struct let ( * ) a b = a + b end > let _ = M.( * ) > EOF - "Not in environment 'M.*'" + { + "file": "test.ml", + "pos": { + "line": 1, + "col": 22 + } + } And need spaces: -FIXME: locate on `M.( *| )` should work: +Locate on `M.( *| )` should work: $ $MERLIN single locate -position 2:13 -filename test.ml <<'EOF' | \ > jq '.value' > module M = struct let ( * ) a b = a + b end > let _ = M.( * ) > EOF - "Not in environment 'M.*'" + { + "file": "test.ml", + "pos": { + "line": 1, + "col": 22 + } + }