From 0110c6aaeb0e8fc8db6a595cbbf3eca4261b3712 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 8 Feb 2023 11:49:52 +0100 Subject: [PATCH 1/3] Add a test illustrating issue #1564 --- tests/test-dirs/type-enclosing/issue1564.t | 59 ++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 tests/test-dirs/type-enclosing/issue1564.t diff --git a/tests/test-dirs/type-enclosing/issue1564.t b/tests/test-dirs/type-enclosing/issue1564.t new file mode 100644 index 0000000000..6fff4d6fb0 --- /dev/null +++ b/tests/test-dirs/type-enclosing/issue1564.t @@ -0,0 +1,59 @@ + $ cat >main.ml < module Kind = struct + > type t = + > | A + > | B + > end + > type t = { kind : Kind.t } + > let x = { kind = A } + > let y = x.kind + > let z = { kind = B }.kind + > EOF + +On `let |y = x.kind` +Verbosity 0 should stop at Kind.t + $ $MERLIN single type-enclosing -position 8:4 -verbosity 0 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "Kind.t" + +On `let |y = x.kind` +Verbosity 1 should show the actual type definition of Kind.t + $ $MERLIN single type-enclosing -position 8:4 -verbosity 1 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "type t = A | B" + +On `let y = x.k|ind` +Verbosity 0 should stop at Kind.t + $ $MERLIN single type-enclosing -position 8:11 -verbosity 0 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "Kind.t" + +On `let y = x.k|ind` +FIXME Verbosity 1 should show the actual type definition of Kind.t + $ $MERLIN single type-enclosing -position 8:11 -verbosity 1 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "Kind.t" + +On `let z = { kind = B }.k|ind` +Verbosity 0 should stop at Kind.t + $ $MERLIN single type-enclosing -position 9:22 -verbosity 0 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "Kind.t" + +On `let z = { kind = B }.k|ind` +Verbosity 1 should show the actual type definition of Kind.t + $ $MERLIN single type-enclosing -position 9:22 -verbosity 1 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "type t = A | B" + +On `let x = { k|ind = A }` +Verbosity 0 should stop at Kind.t + $ $MERLIN single type-enclosing -position 7:12 -verbosity 0 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "Kind.t" + +On `let x = { k|ind = A }` +FIXME Verbosity 1 should show the actual type definition of Kind.t + $ $MERLIN single type-enclosing -position 7:12 -verbosity 1 \ + > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" + "Kind.t" From 2abc09b2e6f2c5f71e7ebc8e285de0b3aee0dc4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 7 Feb 2023 10:48:34 +0100 Subject: [PATCH 2/3] Add special case for labels in type enclosing logic --- src/analysis/type_enclosing.ml | 5 +++++ tests/test-dirs/type-enclosing/issue1564.t | 14 ++++---------- tests/test-dirs/type-enclosing/record.t/run.t | 2 +- 3 files changed, 10 insertions(+), 11 deletions(-) diff --git a/src/analysis/type_enclosing.ml b/src/analysis/type_enclosing.ml index a228241cd8..3f5a714aef 100644 --- a/src/analysis/type_enclosing.ml +++ b/src/analysis/type_enclosing.ml @@ -102,6 +102,11 @@ let from_reconstructed ~nodes ~cursor ~verbosity exprs = let ppf, to_string = Format.to_string () in Type_utils.print_constr ~verbosity env ppf cd; Some (loc, String (to_string ()), `No) + | Some (Context.Label { lbl_name; lbl_arg; _ }) -> + log ~title:"from_reconstructed" "ctx: label %s" lbl_name; + let ppf, to_string = Format.to_string () in + Type_utils.print_type_with_decl ~verbosity env ppf lbl_arg; + Some (loc, String (to_string ()), `No) | Some Context.Constant -> None | _ -> let context = Option.value ~default:Context.Expr context in diff --git a/tests/test-dirs/type-enclosing/issue1564.t b/tests/test-dirs/type-enclosing/issue1564.t index 6fff4d6fb0..6d30cb7c16 100644 --- a/tests/test-dirs/type-enclosing/issue1564.t +++ b/tests/test-dirs/type-enclosing/issue1564.t @@ -11,49 +11,43 @@ > EOF On `let |y = x.kind` -Verbosity 0 should stop at Kind.t +Verbosity 0 stops at Kind.t $ $MERLIN single type-enclosing -position 8:4 -verbosity 0 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" "Kind.t" On `let |y = x.kind` -Verbosity 1 should show the actual type definition of Kind.t +Verbosity 1 shows the actual type definition of Kind.t $ $MERLIN single type-enclosing -position 8:4 -verbosity 1 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" "type t = A | B" On `let y = x.k|ind` -Verbosity 0 should stop at Kind.t $ $MERLIN single type-enclosing -position 8:11 -verbosity 0 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" "Kind.t" On `let y = x.k|ind` -FIXME Verbosity 1 should show the actual type definition of Kind.t $ $MERLIN single type-enclosing -position 8:11 -verbosity 1 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" - "Kind.t" + "type t = A | B" On `let z = { kind = B }.k|ind` -Verbosity 0 should stop at Kind.t $ $MERLIN single type-enclosing -position 9:22 -verbosity 0 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" "Kind.t" On `let z = { kind = B }.k|ind` -Verbosity 1 should show the actual type definition of Kind.t $ $MERLIN single type-enclosing -position 9:22 -verbosity 1 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" "type t = A | B" On `let x = { k|ind = A }` -Verbosity 0 should stop at Kind.t $ $MERLIN single type-enclosing -position 7:12 -verbosity 0 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" "Kind.t" On `let x = { k|ind = A }` -FIXME Verbosity 1 should show the actual type definition of Kind.t $ $MERLIN single type-enclosing -position 7:12 -verbosity 1 \ > -filename ./main.ml < ./main.ml | tr '\r\n' ' ' | jq ".value[0].type" - "Kind.t" + "type t = A | B" diff --git a/tests/test-dirs/type-enclosing/record.t/run.t b/tests/test-dirs/type-enclosing/record.t/run.t index 56cafdf60e..aee28c9d48 100644 --- a/tests/test-dirs/type-enclosing/record.t/run.t +++ b/tests/test-dirs/type-enclosing/record.t/run.t @@ -231,7 +231,7 @@ FIXME: The following results are not entirely satisfying (`foo.Bar -> foo` could "line": 12, "col": 18 }, - "type": "unit", + "type": "type unit = ()", "tail": "no" }, { From 1e831d1e08eea3af48473694df33243164265c1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Wed, 8 Feb 2023 15:32:35 +0100 Subject: [PATCH 3/3] Add changelog entry for #1565 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 05fb185885..cc5c146c44 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -4,6 +4,8 @@ unreleased + merlin binary - Update internal typer to match OCaml 4.14.1 release. (#1557) + - Improve type-enclosing behaviour when used on records' labels (#1565, + fixes #1564) merlin 4.7 ==========