Skip to content

Commit

Permalink
Add test for Construct custom request
Browse files Browse the repository at this point in the history
  • Loading branch information
xvw committed Jul 19, 2024
1 parent b810794 commit 63e7c91
Show file tree
Hide file tree
Showing 4 changed files with 144 additions and 1 deletion.
4 changes: 4 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,10 @@
- Kill unnecessary ocamlformat processes with sigterm rather than sigint or
sigkill (#1343)

## Features

- Add custom [`ocamllsp/construct`](https://github.com/ocaml/ocaml-lsp/blob/ocaml-lsp-server/docs/ocamllsp/construct-spec.md) request (#1348)

# 1.18.0

## Features
Expand Down
137 changes: 137 additions & 0 deletions ocaml-lsp-server/test/e2e-new/construct.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,137 @@
open Test.Import
module Req = Ocaml_lsp_server.Custom_request.Construct

module Util = struct
let call_construct ?depth ?with_values client position =
let uri = DocumentUri.of_path "test.ml" in
let text_document = TextDocumentIdentifier.create ~uri in
let params =
Req.Request_params.create ?depth ?with_values ~text_document ~position ()
|> Req.Request_params.yojson_of_t
|> Jsonrpc.Structured.t_of_yojson
|> Option.some
in
let req = Lsp.Client_request.UnknownRequest { meth = Req.meth; params } in
Client.request client req
;;

let test ?depth ?with_values ~line ~character source =
let position = Position.create ~line ~character in
let request client =
let open Fiber.O in
let+ response = call_construct ?depth ?with_values client position in
Test.print_result response
in
Helpers.test source request
;;
end

let%expect_test "Example sample from merlin 1" =
let source =
{|type r = {the_t: t; id: int}
and t = A | B of r option

let x : t = _
|}
in
let line = 3
and character = 13 in
Util.test ~line ~character source;
[%expect
{|
{
"position": {
"end": { "character": 13, "line": 3 },
"start": { "character": 12, "line": 3 }
},
"result": [ "A", "(B _)" ]
} |}]
;;

let%expect_test "Example sample from merlin 2" =
let source =
{|type r = {the_t: t; id: int}
and t = A | B of r option

let x : t = B _
|}
in
let line = 3
and character = 14 in
Util.test ~line ~character source;
[%expect
{|
{
"position": {
"end": { "character": 15, "line": 3 },
"start": { "character": 14, "line": 3 }
},
"result": [ "None", "(Some _)" ]
} |}]
;;

let%expect_test "Example sample from merlin 3" =
let source =
{|type r = {the_t: t; id: int}
and t = A | B of r option

let x : t = B (Some _)
|}
in
let line = 3
and character = 20 in
Util.test ~line ~character source;
[%expect
{|
{
"position": {
"end": { "character": 21, "line": 3 },
"start": { "character": 20, "line": 3 }
},
"result": [ "{ the_t = _; id = _ }" ]
} |}]
;;

let%expect_test "Example sample from merlin 4" =
let source =
{|type r = {the_t: t; id: int}
and t = A | B of r option

let x : t = B (Some { the_t = _; id = _ })
|}
in
let line = 3
and character = 30 in
Util.test ~line ~character source;
[%expect
{|
{
"position": {
"end": { "character": 31, "line": 3 },
"start": { "character": 30, "line": 3 }
},
"result": [ "A", "(B _)" ]
} |}]
;;

let%expect_test "Example sample from merlin 5" =
let source =
{|type r = {the_t: t; id: int}
and t = A | B of r option

let x : t = B (Some { the_t = A; id = _ })
|}
in
let line = 3
and character = 38 in
Util.test ~line ~character source;
[%expect
{|
{
"position": {
"end": { "character": 39, "line": 3 },
"start": { "character": 38, "line": 3 }
},
"result": [ "0" ]
} |}]
;;
1 change: 1 addition & 0 deletions ocaml-lsp-server/test/e2e-new/dune
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@
code_actions
completion
completions
construct
doc_to_md
document_flow
exit_notification
Expand Down
3 changes: 2 additions & 1 deletion ocaml-lsp-server/test/e2e-new/start_stop.ml
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,8 @@ let%expect_test "start/stop" =
"diagnostic_promotions": true,
"handleHoverExtended": true,
"handleMerlinCallCompatible": true,
"handleTypeEnclosing": true
"handleTypeEnclosing": true,
"handleConstruct": true
}
},
"foldingRangeProvider": true,
Expand Down

0 comments on commit 63e7c91

Please sign in to comment.