From def7667b147621c58feadfa8c1b33a13f71f8127 Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Fri, 15 Sep 2023 09:36:05 +0200 Subject: [PATCH] Import LSP tests --- test/lsp/dune | 10 + test/lsp/lsp_basics.ml | 34 +++ test/lsp/lsp_definition.ml | 340 ++++++++++++++++++++++ test/lsp/lsp_formatting.ml | 570 +++++++++++++++++++++++++++++++++++++ test/lsp/lsp_hover.ml | 142 +++++++++ test/lsp/lsp_references.ml | 307 ++++++++++++++++++++ test/lsp/lsp_testing.ml | 230 +++++++++++++++ test/lsp/lsp_testing.mli | 41 +++ 8 files changed, 1674 insertions(+) create mode 100644 test/lsp/dune create mode 100644 test/lsp/lsp_basics.ml create mode 100644 test/lsp/lsp_definition.ml create mode 100644 test/lsp/lsp_formatting.ml create mode 100644 test/lsp/lsp_hover.ml create mode 100644 test/lsp/lsp_references.ml create mode 100644 test/lsp/lsp_testing.ml create mode 100644 test/lsp/lsp_testing.mli diff --git a/test/lsp/dune b/test/lsp/dune new file mode 100644 index 000000000..27fcddfaf --- /dev/null +++ b/test/lsp/dune @@ -0,0 +1,10 @@ +; if you modify this file, add 'test' to the 'skip' field in drom.toml + +(library + (name lsp_test_all) + (preprocess + (pps ppx_expect)) + (inline_tests + (modes best)) ; add js for testing with nodejs + (libraries cobol_lsp lsp superbol_free_lib superbol_testutils) + ) diff --git a/test/lsp/lsp_basics.ml b/test/lsp/lsp_basics.ml new file mode 100644 index 000000000..e59af1311 --- /dev/null +++ b/test/lsp/lsp_basics.ml @@ -0,0 +1,34 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) + +open Lsp_testing + +let%expect_test "add-empty-cobol-doc" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + ignore @@ add_cobol_doc server ~projdir "prog.cob" ""; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} +|}];; + +let%expect_test "add-simple-cobol-doc" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + ignore @@ add_cobol_doc server ~projdir "prog.cob" {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + STOP RUN. + |cobol}; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} +|}];; diff --git a/test/lsp/lsp_definition.ml b/test/lsp/lsp_definition.ml new file mode 100644 index 000000000..8a7ea6623 --- /dev/null +++ b/test/lsp/lsp_definition.ml @@ -0,0 +1,340 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) + +open EzCompat (* StringMap *) +open Lsp.Types +open Lsp_testing + + +let print_definitions ~projdir server (doc, positions) : unit = + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let location_as_srcloc = new srcloc_resuscitator_cache in + StringMap.iter begin fun position_name position -> + let params = DefinitionParams.create ~position ~textDocument:prog () in + Pretty.out "%s (line %d, character %d):@." + position_name position.line position.character; + match LSP.Request.lookup_definition server params with + | None | Some (`Location []) -> + Pretty.out "No definition found@." + | Some (`Location locs) -> + List.iter location_as_srcloc#print locs + (* Yojson.Safe.to_channel Stdlib.stdout @@ *) + (* Lsp.Client_request.yojson_of_result *) + (* (Lsp.Client_request.TextDocumentDefinition params) *) + (* (LSP.Request.lookup_definition server params); *) + end positions.pos_map +;; + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 DATA-_|1-data-name-in-def|_NAME PIC X. + PROCEDURE DIVISION. + DISPLAY _|2-data-name-in-display|_DATA-NAME + STOP RUN. + |cobol} +;; + +let%expect_test "simple-definition-requests" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_definitions ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-def (line 5, character 16): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME + 2-data-name-in-display (line 7, character 18): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 0_|1-data-name-in-def|_1 DATA-_|2-data-name-in-def|_NAME P_|3-data-name-in-def|_IC X. + PROCEDURE DIVISION. + DISPLAY DATA-NAME + STOP RUN. + |cobol} +;; + +let%expect_test "simple-definition-requests-2" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_definitions ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-def (line 5, character 9): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME + 2-data-name-in-def (line 5, character 16): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME + 3-data-name-in-def (line 5, character 22): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME |}] + + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X. + 05 Y PIC 9. + PROCEDURE DIVISION. + DISPLAY _|1-data-name-in-display|_Y of _|2-data-name-in-display|_X. + STOP RUN. + |cobol} +;; + +let%expect_test "simple-definition-requests-2" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_definitions ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-display (line 8, character 20): + __rootdir__/prog.cob:7.15-7.16: + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 > 05 Y PIC 9. + ---- ^ + 8 PROCEDURE DIVISION. + 9 DISPLAY Y of X. + 2-data-name-in-display (line 8, character 25): + __rootdir__/prog.cob:6.11-6.12: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 X. + ---- ^ + 7 05 Y PIC 9. + 8 PROCEDURE DIVISION. |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X. + 05 Y PIC 9. + 66 Z RENAMES _|1-data-name-renamed|_Y. + PROCEDURE DIVISION. + DISPLAY _|2-data-name-in-display|_Z. + STOP RUN. + |cobol} +;; + +let%expect_test "definition-requests-renames" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_definitions ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-renamed (line 7, character 25): + __rootdir__/prog.cob:7.15-7.16: + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 > 05 Y PIC 9. + ---- ^ + 8 66 Z RENAMES Y. + 9 PROCEDURE DIVISION. + 2-data-name-in-display (line 9, character 20): + __rootdir__/prog.cob:8.15-8.16: + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 05 Y PIC 9. + 8 > 66 Z RENAMES Y. + ---- ^ + 9 PROCEDURE DIVISION. + 10 DISPLAY Z. |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 Y PIC XXX. + 01 X. + 05 Y. + 10 Z PIC 999999. + 05 FILLER REDEFINES _|1-data-name-redefined|_Y. + 10 A PIC 9 OCCURS 6 TIMES. + 05 STH REDEFINES _|2-data-name-redefined|_Y. + 10 B PIC 99 OCCURS 3 TIMES. + 05 FILLER REDEFINES _|3-data-name-redefined|_Y. + 10 C PIC 999 OCCURS 2 TIMES. + PROCEDURE DIVISION. + DISPLAY _|4-data-name-in-display|_A. + |cobol} +;; + +let%expect_test "definition-requests-redefines" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_definitions ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-redefined (line 9, character 32): + __rootdir__/prog.cob:8.15-8.16: + 5 WORKING-STORAGE SECTION. + 6 01 Y PIC XXX. + 7 01 X. + 8 > 05 Y. + ---- ^ + 9 10 Z PIC 999999. + 10 05 FILLER REDEFINES Y. + 2-data-name-redefined (line 11, character 29): + __rootdir__/prog.cob:8.15-8.16: + 5 WORKING-STORAGE SECTION. + 6 01 Y PIC XXX. + 7 01 X. + 8 > 05 Y. + ---- ^ + 9 10 Z PIC 999999. + 10 05 FILLER REDEFINES Y. + 3-data-name-redefined (line 13, character 32): + __rootdir__/prog.cob:8.15-8.16: + 5 WORKING-STORAGE SECTION. + 6 01 Y PIC XXX. + 7 01 X. + 8 > 05 Y. + ---- ^ + 9 10 Z PIC 999999. + 10 05 FILLER REDEFINES Y. + 4-data-name-in-display (line 16, character 20): + __rootdir__/prog.cob:11.19-11.20: + 8 05 Y. + 9 10 Z PIC 999999. + 10 05 FILLER REDEFINES Y. + 11 > 10 A PIC 9 OCCURS 6 TIMES. + ---- ^ + 12 05 STH REDEFINES Y. + 13 10 B PIC 99 OCCURS 3 TIMES. |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01. + 05 H1 PIC 999. + 05. + 10 _|1-data-name-in-def|_H PIC 999. + 05 H2 PIC 999. + 01 X. + 05 W PIC 999. + 05 FILLER. + 10 _|2-data-name-in-def|_Z PIC 999. + 01. + 05 _|3-data-name-in-def|_T PIC 999. + PROCEDURE DIVISION. + DISPLAY _|4-data-name-in-display|_Z OF X. + STOP RUN. + |cobol} +;; + +let%expect_test "definition-requests-filler" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_definitions ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-def (line 8, character 15): + __rootdir__/prog.cob:9.15-9.16: + 6 01. + 7 05 H1 PIC 999. + 8 05. + 9 > 10 H PIC 999. + ---- ^ + 10 05 H2 PIC 999. + 11 01 X. + 2-data-name-in-def (line 13, character 15): + __rootdir__/prog.cob:14.15-14.16: + 11 01 X. + 12 05 W PIC 999. + 13 05 FILLER. + 14 > 10 Z PIC 999. + ---- ^ + 15 01. + 16 05 T PIC 999. + 3-data-name-in-def (line 15, character 13): + __rootdir__/prog.cob:16.13-16.14: + 13 05 FILLER. + 14 10 Z PIC 999. + 15 01. + 16 > 05 T PIC 999. + ---- ^ + 17 PROCEDURE DIVISION. + 18 DISPLAY Z OF X. + 4-data-name-in-display (line 17, character 18): + __rootdir__/prog.cob:14.15-14.16: + 11 01 X. + 12 05 W PIC 999. + 13 05 FILLER. + 14 > 10 Z PIC 999. + ---- ^ + 15 01. + 16 05 T PIC 999. |}] diff --git a/test/lsp/lsp_formatting.ml b/test/lsp/lsp_formatting.ml new file mode 100644 index 000000000..9a0cb29bb --- /dev/null +++ b/test/lsp/lsp_formatting.ml @@ -0,0 +1,570 @@ +(******************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(******************************************************************************) + +open Lsp.Types +open Lsp_testing + +let doc = {cobol| + PROGRAM-ID. HELLO. + PROCEDURE DIVISION. + para-1. + DISPLAY "HELLO" + STOP RUN. + |cobol};; + +let%expect_test "simple-formatting-request" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + PROGRAM-ID. HELLO. + PROCEDURE DIVISION. + para-1. + DISPLAY "HELLO" + STOP RUN. |}] + + +let doc = {cobol| + para-1. + IF X>9 + THEN + IF X>6 + THEN + DISPLAY "2" + else + move 1 to x + else + move 1 to x. |cobol};; + +let%expect_test "formatting-request-nested-if" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":14,"line":1},"start":{"character":8,"line":1}},"severity":1},{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + para-1. + IF X>9 + THEN + IF X>6 + THEN + DISPLAY "2" + else + move 1 to x + else + move 1 to x. |}] + + +let doc = {cobol| + WORKING-STORAGE SECTION. + 01 x. + 05 y. + 10 z pic 999. + 05 h pic 99. + 66 z renames x. + 01 X1 + OCCURS 3 times + DEPENDING ON X2 + ASCENDING KEY is X3 + INDEXED BY X4 + value 999. |cobol};; + +let%expect_test "formatting-request-data" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect{| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":23,"line":1},"start":{"character":8,"line":1}},"severity":1},{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + WORKING-STORAGE SECTION. + 01 x. + 05 y. + 10 z pic 999. + 05 h pic 99. + 66 z renames x. + 01 X1 + OCCURS 3 times + DEPENDING ON X2 + ASCENDING KEY is X3 + INDEXED BY X4 + value 999. |}] + + +let doc = {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. X. + PROCEDURE DIVISION. + DISPLAY "I'm in X" + CALL "X1" + CALL "X2" + STOP RUN. + + IDENTIFICATION DIVISION. + PROGRAM-ID. X1. + PROCEDURE DIVISION. + DISPLAY "I'm in X1" + CALL "X11" + CALL "X12" + EXIT Program. + + IDENTIFICATION DIVISION. + PROGRAM-ID. X11. + PROCEDURE DIVISION. + DISPLAY "I'm in X11" + EXIT Program. + END PROGRAM X11. + + IDENTIFICATION DIVISION. + PROGRAM-ID. X12. + PROCEDURE DIVISION. + DISPLAY "I'm in X12" + EXIT Program. + END PROGRAM X12. + + END PROGRAM X1. + + IDENTIFICATION DIVISION. + PROGRAM-ID. X2. + PROCEDURE DIVISION. + DISPLAY "I'm in X2" + EXIT Program. + END PROGRAM X2. + + END PROGRAM X. + |cobol};; + +let%expect_test "formatting-request-nested-program" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect{| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + IDENTIFICATION DIVISION. + PROGRAM-ID. X. + PROCEDURE DIVISION. + DISPLAY "I'm in X" + CALL "X1" + CALL "X2" + STOP RUN. + IDENTIFICATION DIVISION. + PROGRAM-ID. X1. + PROCEDURE DIVISION. + DISPLAY "I'm in X1" + CALL "X11" + CALL "X12" + EXIT Program. + IDENTIFICATION DIVISION. + PROGRAM-ID. X11. + PROCEDURE DIVISION. + DISPLAY "I'm in X11" + EXIT Program. + END PROGRAM X11. + IDENTIFICATION DIVISION. + PROGRAM-ID. X12. + PROCEDURE DIVISION. + DISPLAY "I'm in X12" + EXIT Program. + END PROGRAM X12. + END PROGRAM X1. + IDENTIFICATION DIVISION. + PROGRAM-ID. X2. + PROCEDURE DIVISION. + DISPLAY "I'm in X2" + EXIT Program. + END PROGRAM X2. + END PROGRAM X. |}] + + +let doc = {cobol| + MOVE VAR-1 TO VAR-2 VAR-3 + VAR-4 + VAR-5. + |cobol};; + +let%expect_test "formatting-request-alignment-argument" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":11,"line":1},"start":{"character":7,"line":1}},"severity":1},{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + MOVE VAR-1 TO VAR-2 VAR-3 + VAR-4 + VAR-5. |}] + + +let doc = {cobol| + if x>1 + move 1 to x + else if x>2 + move 2 to x + else if x>3 + move 3 to x + else + move 4 to x. + |cobol};; + +let%expect_test "formatting-request-else-if" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":10,"line":1},"start":{"character":8,"line":1}},"severity":1},{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + if x>1 + move 1 to x + else if x>2 + move 2 to x + else if x>3 + move 3 to x + else + move 4 to x. |}] + + +let doc = {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. MACESDS. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT MACC ASSIGN TO RRDSFILE + ORGANIZATION RELATIVE + ACCESS MODE DYNAMIC + RELATIVE KEY RK + FILE STATUS FS. + DATA DIVISION. + FILE SECTION. + FD MACC. + 01 MREC. + 05 MNO PIC 9(5). + 05 MNAME PIC X(10). + WORKING-STORAGE SECTION. + 01 FS PIC X(2). + 01 A PIC 99 VALUE 00. + 01 B PIC 9(5) VALUE ZERO. + 01 IREC. + 05 INO PIC 9(5). + 05 INAME PIC X(10). + 01 RK PIC 9(02) VALUE 01. + PROCEDURE DIVISION. + 0001. + DISPLAY "ENTER 1.SEAR/2.WRITE/3.REWR/4.DEL/5.DELALL/6.DISP". + ACCEPT A. + IF A = 1 GO 1SEARCH + ELSE IF A = 2 GO 2WRITE + ELSE IF A = 3 GO 3REWRITE + ELSE IF A = 4 GO 4DELETE + ELSE IF A = 5 GO 5DELALL + ELSE IF A = 6 GO 6DISPLAY + ELSE DISPLAY "INVALID INPUT" + GO 0001. + STOP RUN. + 1SEARCH. + OPEN INPUT MACC. + ACCEPT B. + 0002. + READ MACC NEXT AT END DISPLAY B "NOT FOUND", GO 000X. + IF B = MNO DISPLAY "FOUND " MNO ":" , + DISPLAY " AT POS:" A " FOR NAME: " MNAME, + GO 000X. + ADD 1 TO A. + GO TO 0002. + 2WRITE. + OPEN I-O MACC. + IF FS = 00 PERFORM RKKEY UNTIL FS = 10 + ELSE OPEN OUTPUT MACC. + DISPLAY RK. + ACCEPT MNO. + ACCEPT MNAME. + WRITE MREC INVALID KEY DISPLAY "DUPLICATE KEY!". + GO 000X. + 3REWRITE. + OPEN I-O MACC. + ACCEPT RK. + ACCEPT MNO. + ACCEPT MNAME. + REWRITE MREC INVALID KEY DISPLAY "NOT FOUND". + GO 000X. + 4DELETE. + OPEN I-O MACC. + ACCEPT RK. + DELETE MACC INVALID KEY DISPLAY "NOT FOUND". + GO 000X. + 5DELALL. + OPEN I-O MACC. + MOVE 01 TO RK. + 0003. + DELETE MACC INVALID KEY GO 000X. + ADD 01 TO RK. + GO 0003. + 6DISPLAY. + OPEN INPUT MACC. + 0005. + READ MACC NEXT INTO IREC AT END GO 000X. + DISPLAY INO, " ", INAME. + GO 0005. + 000X. + CLOSE MACC. + DISPLAY "CONTINUE?1/0". + ACCEPT A. + IF A = 0 STOP RUN ELSE GO 0001. + RKKEY. + READ MACC NEXT. + ADD 1 TO RK. + |cobol};; + +let%expect_test "formatting-request-whole-program" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + public/src/lsp/cobol_ast/raw_misc_sections_visitor.ml:66: + (Cobol_ast__Raw_misc_sections_visitor.fold_select_clause): missing visitor + implementation + public/src/lsp/cobol_ast/raw_data_sections_visitor.ml:280: + (Cobol_ast__Raw_data_sections_visitor.fold_file_section): missing visitor + implementation + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + IDENTIFICATION DIVISION. + PROGRAM-ID. MACESDS. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT MACC ASSIGN TO RRDSFILE + ORGANIZATION RELATIVE + ACCESS MODE DYNAMIC + RELATIVE KEY RK + FILE STATUS FS. + DATA DIVISION. + FILE SECTION. + FD MACC. + 01 MREC. + 05 MNO PIC 9(5). + 05 MNAME PIC X(10). + WORKING-STORAGE SECTION. + 01 FS PIC X(2). + 01 A PIC 99 VALUE 00. + 01 B PIC 9(5) VALUE ZERO. + 01 IREC. + 05 INO PIC 9(5). + 05 INAME PIC X(10). + 01 RK PIC 9(02) VALUE 01. + PROCEDURE DIVISION. + 0001. + DISPLAY "ENTER 1.SEAR/2.WRITE/3.REWR/4.DEL/5.DELALL/6.DISP". + ACCEPT A. + IF A = 1 GO 1SEARCH + ELSE IF A = 2 GO 2WRITE + ELSE IF A = 3 GO 3REWRITE + ELSE IF A = 4 GO 4DELETE + ELSE IF A = 5 GO 5DELALL + ELSE IF A = 6 GO 6DISPLAY + ELSE DISPLAY "INVALID INPUT" + GO 0001. + STOP RUN. + 1SEARCH. + OPEN INPUT MACC. + ACCEPT B. + 0002. + READ MACC NEXT AT END DISPLAY B "NOT FOUND", GO 000X. + IF B = MNO DISPLAY "FOUND " MNO ":" , + DISPLAY " AT POS:" A " FOR NAME: " MNAME, + GO 000X. + ADD 1 TO A. + GO TO 0002. + 2WRITE. + OPEN I-O MACC. + IF FS = 00 PERFORM RKKEY UNTIL FS = 10 + ELSE OPEN OUTPUT MACC. + DISPLAY RK. + ACCEPT MNO. + ACCEPT MNAME. + WRITE MREC INVALID KEY DISPLAY "DUPLICATE KEY!". + GO 000X. + 3REWRITE. + OPEN I-O MACC. + ACCEPT RK. + ACCEPT MNO. + ACCEPT MNAME. + REWRITE MREC INVALID KEY DISPLAY "NOT FOUND". + GO 000X. + 4DELETE. + OPEN I-O MACC. + ACCEPT RK. + DELETE MACC INVALID KEY DISPLAY "NOT FOUND". + GO 000X. + 5DELALL. + OPEN I-O MACC. + MOVE 01 TO RK. + 0003. + DELETE MACC INVALID KEY GO 000X. + ADD 01 TO RK. + GO 0003. + 6DISPLAY. + OPEN INPUT MACC. + 0005. + READ MACC NEXT INTO IREC AT END GO 000X. + DISPLAY INO, " ", INAME. + GO 0005. + 000X. + CLOSE MACC. + DISPLAY "CONTINUE?1/0". + ACCEPT A. + IF A = 0 STOP RUN ELSE GO 0001. + RKKEY. + READ MACC NEXT. + ADD 1 TO RK. |}] + + + +let doc = {cobol| + CALL STH + NOT ON EXCEPTION + RAISE EXCEPTION exception-name-1 + EXCEPTION + DISPLAY "ERROR" + END-CALL. + |cobol};; + +let%expect_test "formatting-request-on-exception" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect{| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":11,"line":1},"start":{"character":7,"line":1}},"severity":1},{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + CALL STH + NOT ON EXCEPTION + RAISE EXCEPTION exception-name-1 + EXCEPTION + DISPLAY "ERROR" + END-CALL. |}] + + +let doc = {cobol| + PROCEDURE DIVISION. + para-1. + PERFORM 3 TIMES + PERFORM PARA-2 + END-PERFORM + STOP RUN. + PARA-2. + DISPLAY "HELLO". + |cobol};; + +let%expect_test "formatting-request-perform" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let params = + let options = FormattingOptions.create ~insertSpaces:true ~tabSize:2 () in + DocumentFormattingParams.create ~options ~textDocument:prog () + in + begin match LSP.Request.formatting server params with + | None -> Pretty.out "formatting error" + | Some l -> + List.iter (fun TextEdit.{newText;_} -> Pretty.out "%s" newText) l + end; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":16,"line":1},"start":{"character":7,"line":1}},"severity":1},{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + >> Warning: Source format `auto` is not supported yet, using `fixed` + PROCEDURE DIVISION. + para-1. + PERFORM 3 TIMES + PERFORM PARA-2 + END-PERFORM + STOP RUN. + PARA-2. + DISPLAY "HELLO". |}] diff --git a/test/lsp/lsp_hover.ml b/test/lsp/lsp_hover.ml new file mode 100644 index 000000000..2bbd96a2f --- /dev/null +++ b/test/lsp/lsp_hover.ml @@ -0,0 +1,142 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) + +open Lsp.Types +open Lsp_testing + +let print_hovered server ~projdir (prog, prog_positions) = + let server, prog = add_cobol_doc server ~projdir "prog.cob" prog in + let location_as_srcloc = new srcloc_resuscitator_cache in + let hover_position ?key position = + let params = HoverParams.create ~position ~textDocument:prog () in + Pretty.out "%a(line %d, character %d):@." + Fmt.(option ~none:nop @@ fmt "%s ") key + position.line position.character; + match LSP.Request.hover server params with + | None -> + Pretty.out "Hovering nothing worthy@." + | Some { contents = `List strings; range } -> + location_as_srcloc#print_optional_range_for ~uri:prog.uri range; + List.iter (fun MarkedString.{ value; _ } -> print_endline value) strings + | Some { contents = `MarkedString MarkedString.{ value; _ } | + `MarkupContent MarkupContent.{ value; _ }; range } -> + location_as_srcloc#print_optional_range_for ~uri:prog.uri range; + print_endline value + in + List.iter (fun pos -> hover_position pos) prog_positions.pos_anonymous; + StrMap.iter (fun key pos -> hover_position ~key pos) prog_positions.pos_map + +(* hover copy *) + +let lib = {cobol| + 01 FIELD PIC X. + |cobol};; + +let prog = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + _|_COP_|_Y "_|_li_|_b.cpy". + PROCEDURE DIVISION. + DISPLAY FI_|_ELD + STOP RUN. + |cobol};; + +let%expect_test "hover-copy" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + let server, _ = add_cobol_doc server ~projdir "lib.cpy" lib in + print_hovered server ~projdir prog; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[],"uri":"file://__rootdir__/lib.cpy"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + (line 5, character 7): + __rootdir__/prog.cob:6.7-6.22: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > COPY "lib.cpy". + ---- ^^^^^^^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY FIELD + ```cobol + 01 FIELD PIC X. + ``` + (line 5, character 10): + __rootdir__/prog.cob:6.7-6.22: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > COPY "lib.cpy". + ---- ^^^^^^^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY FIELD + ```cobol + 01 FIELD PIC X. + ``` + (line 5, character 13): + __rootdir__/prog.cob:6.7-6.22: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > COPY "lib.cpy". + ---- ^^^^^^^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY FIELD + ```cobol + 01 FIELD PIC X. + ``` + (line 5, character 15): + __rootdir__/prog.cob:6.7-6.22: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > COPY "lib.cpy". + ---- ^^^^^^^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY FIELD + ```cobol + 01 FIELD PIC X. + ``` + (line 7, character 20): + Hovering nothing worthy |}];; + +(* Hover replaced *) + +let prog = + extract_position_markers {cobol| + REPLACE =="A"== BY =="B" "C"==. + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + PROCEDURE DIVISION. + DISPLAY "_|_A" + STOP RUN. + |cobol};; + +let%expect_test "hover-replaced" = + let { projdir; end_with_postproc }, server = make_lsp_project () in + print_hovered server ~projdir prog; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + (line 5, character 19): + __rootdir__/prog.cob:6.18-6.21: + 3 IDENTIFICATION DIVISION. + 4 PROGRAM-ID. prog. + 5 PROCEDURE DIVISION. + 6 > DISPLAY "A" + ---- ^^^ + 7 STOP RUN. + 8 + ``"B" "C"`` |}];; diff --git a/test/lsp/lsp_references.ml b/test/lsp/lsp_references.ml new file mode 100644 index 000000000..c57d05279 --- /dev/null +++ b/test/lsp/lsp_references.ml @@ -0,0 +1,307 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) +open EzCompat (* StringMap *) +open Lsp.Types +open Lsp_testing + + +let print_references ~projdir server (doc, positions) : unit = + let server, prog = add_cobol_doc server ~projdir "prog.cob" doc in + let location_as_srcloc = new srcloc_resuscitator_cache in + Pretty.out "@."; + StringMap.iter begin fun position_name position -> + let params = + (*includeDeclaration*) + let context = ReferenceContext.create ~includeDeclaration:true in + ReferenceParams.create ~position ~textDocument:prog ~context () + in + Pretty.out "%s (line %d, character %d):@." + position_name position.line position.character; + match LSP.Request.lookup_references server params with + | None | Some [] -> + Pretty.out "No reference found@." + | Some locs -> + List.iter location_as_srcloc#print locs + end positions.pos_map +;; + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 DATA-_|1-data-name-in-def|_NAME PI_|2-data-name-in-def|_C X. + PROCEDURE DIVISION. + DISPLAY _|3-data-name-in-display|_DATA-NAME + DISPLAY _|4-data-name-in-display|_X. + STOP RUN. + |cobol} +;; + + +let%expect_test "simple-references-requests" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_references ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + public/src/lsp/cobol_ast/raw_data_sections_visitor.ml:231: + (Cobol_ast__Raw_data_sections_visitor.fold_data_clause): partial visitor + implementation + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-def (line 5, character 16): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME + __rootdir__/prog.cob:8.18-8.27: + 5 WORKING-STORAGE SECTION. + 6 01 DATA-NAME PIC X. + 7 PROCEDURE DIVISION. + 8 > DISPLAY DATA-NAME + ---- ^^^^^^^^^ + 9 DISPLAY X. + 10 STOP RUN. + 2-data-name-in-def (line 5, character 23): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME + __rootdir__/prog.cob:8.18-8.27: + 5 WORKING-STORAGE SECTION. + 6 01 DATA-NAME PIC X. + 7 PROCEDURE DIVISION. + 8 > DISPLAY DATA-NAME + ---- ^^^^^^^^^ + 9 DISPLAY X. + 10 STOP RUN. + 3-data-name-in-display (line 7, character 18): + __rootdir__/prog.cob:6.11-6.20: + 3 PROGRAM-ID. prog. + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 > 01 DATA-NAME PIC X. + ---- ^^^^^^^^^ + 7 PROCEDURE DIVISION. + 8 DISPLAY DATA-NAME + __rootdir__/prog.cob:8.18-8.27: + 5 WORKING-STORAGE SECTION. + 6 01 DATA-NAME PIC X. + 7 PROCEDURE DIVISION. + 8 > DISPLAY DATA-NAME + ---- ^^^^^^^^^ + 9 DISPLAY X. + 10 STOP RUN. + 4-data-name-in-display (line 8, character 18): + No reference found |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X. + 05 Y PIC 9. + 66 Z RENAMES _|1-data-name-renamed|_Y. + PROCEDURE DIVISION. + DISPLAY _|2-data-name-in-display|_Z. + STOP RUN. + |cobol} +;; + +let%expect_test "references-requests-renames" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_references ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-renamed (line 7, character 25): + __rootdir__/prog.cob:7.15-7.16: + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 > 05 Y PIC 9. + ---- ^ + 8 66 Z RENAMES Y. + 9 PROCEDURE DIVISION. + __rootdir__/prog.cob:8.25-8.26: + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 05 Y PIC 9. + 8 > 66 Z RENAMES Y. + ---- ^ + 9 PROCEDURE DIVISION. + 10 DISPLAY Z. + 2-data-name-in-display (line 9, character 20): + __rootdir__/prog.cob:8.15-8.16: + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 05 Y PIC 9. + 8 > 66 Z RENAMES Y. + ---- ^ + 9 PROCEDURE DIVISION. + 10 DISPLAY Z. + __rootdir__/prog.cob:10.20-10.21: + 7 05 Y PIC 9. + 8 66 Z RENAMES Y. + 9 PROCEDURE DIVISION. + 10 > DISPLAY Z. + ---- ^ + 11 STOP RUN. + 12 |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 X. + 05 Y. + 10 Z PIC 999999. + 05 FILLER REDEFINES Y. + 10 A PIC 9 OCCURS 6 TIMES. + 05 STH REDEFINES Y. + 10 B PIC 99 OCCURS 3 TIMES. + 05 FILLER REDEFINES Y. + 10 C PIC 999 OCCURS 2 TIMES. + PROCEDURE DIVISION. + DISPLAY _|1-data-name-in-display|_Y. + |cobol} +;; + +let%expect_test "references-requests-redefines" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_references ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-display (line 15, character 20): + __rootdir__/prog.cob:7.15-7.16: + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 01 X. + 7 > 05 Y. + ---- ^ + 8 10 Z PIC 999999. + 9 05 FILLER REDEFINES Y. + __rootdir__/prog.cob:9.32-9.33: + 6 01 X. + 7 05 Y. + 8 10 Z PIC 999999. + 9 > 05 FILLER REDEFINES Y. + ---- ^ + 10 10 A PIC 9 OCCURS 6 TIMES. + 11 05 STH REDEFINES Y. + __rootdir__/prog.cob:11.29-11.30: + 8 10 Z PIC 999999. + 9 05 FILLER REDEFINES Y. + 10 10 A PIC 9 OCCURS 6 TIMES. + 11 > 05 STH REDEFINES Y. + ---- ^ + 12 10 B PIC 99 OCCURS 3 TIMES. + 13 05 FILLER REDEFINES Y. + __rootdir__/prog.cob:13.32-13.33: + 10 10 A PIC 9 OCCURS 6 TIMES. + 11 05 STH REDEFINES Y. + 12 10 B PIC 99 OCCURS 3 TIMES. + 13 > 05 FILLER REDEFINES Y. + ---- ^ + 14 10 C PIC 999 OCCURS 2 TIMES. + 15 PROCEDURE DIVISION. + __rootdir__/prog.cob:16.20-16.21: + 13 05 FILLER REDEFINES Y. + 14 10 C PIC 999 OCCURS 2 TIMES. + 15 PROCEDURE DIVISION. + 16 > DISPLAY Y. + ---- ^ + 17 |}] + + +let doc = + extract_position_markers {cobol| + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 FILLER. + 05 X PIC 999. + 05 FILLER REDEFINES X. + 10 Z PIC 9 OCCURS 3 TIMES. + 66 Y RENAMES X. + PROCEDURE DIVISION. + DISPLAY _|1-data-name-in-display|_X . + MOVE 1 TO X. + STOP RUN. + |cobol} +;; + +let%expect_test "references-requests-filler" = + let { end_with_postproc; projdir }, server = make_lsp_project () in + print_references ~projdir server doc; + end_with_postproc [%expect.output]; + [%expect {| + {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + {"params":{"diagnostics":[{"message":"Source format `auto` is not supported yet, using `fixed`","range":{"end":{"character":0,"line":0},"start":{"character":0,"line":0}},"severity":2}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} + 1-data-name-in-display (line 11, character 18): + __rootdir__/prog.cob:7.13-7.14: + 4 DATA DIVISION. + 5 WORKING-STORAGE SECTION. + 6 01 FILLER. + 7 > 05 X PIC 999. + ---- ^ + 8 05 FILLER REDEFINES X. + 9 10 Z PIC 9 OCCURS 3 TIMES. + __rootdir__/prog.cob:8.30-8.31: + 5 WORKING-STORAGE SECTION. + 6 01 FILLER. + 7 05 X PIC 999. + 8 > 05 FILLER REDEFINES X. + ---- ^ + 9 10 Z PIC 9 OCCURS 3 TIMES. + 10 66 Y RENAMES X. + __rootdir__/prog.cob:10.23-10.24: + 7 05 X PIC 999. + 8 05 FILLER REDEFINES X. + 9 10 Z PIC 9 OCCURS 3 TIMES. + 10 > 66 Y RENAMES X. + ---- ^ + 11 PROCEDURE DIVISION. + 12 DISPLAY X . + __rootdir__/prog.cob:12.18-12.19: + 9 10 Z PIC 9 OCCURS 3 TIMES. + 10 66 Y RENAMES X. + 11 PROCEDURE DIVISION. + 12 > DISPLAY X . + ---- ^ + 13 MOVE 1 TO X. + 14 STOP RUN. + __rootdir__/prog.cob:13.20-13.21: + 10 66 Y RENAMES X. + 11 PROCEDURE DIVISION. + 12 DISPLAY X . + 13 > MOVE 1 TO X. + ---- ^ + 14 STOP RUN. + 15 |}] diff --git a/test/lsp/lsp_testing.ml b/test/lsp/lsp_testing.ml new file mode 100644 index 000000000..7bd6ee593 --- /dev/null +++ b/test/lsp/lsp_testing.ml @@ -0,0 +1,230 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) + +(** This module gathers various utilities that can be used to test the LSP. *) + +(* Note that for now, only a single project directory may be used, and we may + need to clean it up after each test. *) + +open Cobol_common.Srcloc.TYPES + +open Lsp.Types +open Ez_file.V1 +open Ez_file.FileString.OP + +module StrMap = EzCompat.StringMap +module LSP = Cobol_lsp.INTERNAL + +(** {1 Server initialization} *) + +let layout = + LSP.Project.{ + project_config_filename = Superbol_free_lib.Command_lsp.project_config_filename; + } +and cache_config = + LSP.Project_cache.{ + cache_relative_filename = "lsp-cache"; + cache_verbose = false; + } + +let init_temp_project ?(toml = "") () = + let projdir = Superbol_testutils.Tempdir.make_n_enter "superbol-project" in + let toml_file = projdir // layout.project_config_filename in + EzFile.write_file toml_file toml; + projdir + +let make_server () = + LSP.Server.init ~config:{ project_layout = layout; cache_config } + +let add_cobol_doc server ?copybook ~projdir filename text = + let path = projdir // filename in + let uri = Lsp.Uri.of_path path in + EzFile.write_file path text; + let server = + LSP.Server.add ?copybook + DidOpenTextDocumentParams.{ + textDocument = TextDocumentItem.{ + languageId = "cobol"; version = 0; text; uri; + }; + } server + in + print_newline (); + server, TextDocumentIdentifier.create ~uri + +(* let projdir = init_temp_project () *) +(* let projdir_regexp = Str.(regexp @@ quote projdir) *) +(* let projdir_marker = "__rootdir__" *) + +(* let print_postproc jsonrpc = *) +(* EzString.split jsonrpc '\n' |> *) +(* List.filter_map begin function *) +(* | s when String.trim s = "" -> None (\* ignore json RPC header: *\) *) +(* | s when EzString.starts_with ~prefix:"Content-Length: " s -> None *) +(* | s -> Some (Str.global_replace projdir_regexp projdir_marker s) *) +(* end |> *) +(* String.concat "\n" |> *) +(* print_endline *) + +let projdir_marker = "__rootdir__" + +type test_project = + { + projdir: string; + end_with_postproc: string -> unit; + } + +let make_lsp_project ?toml () = + let projdir = init_temp_project ?toml () in + let projdir_regexp = Str.(regexp @@ quote projdir) in + let temp_dir_name = Filename.get_temp_dir_name () in + let end_with_postproc expected_output_string = + (* Remove temporary project directory *) + if EzString.starts_with ~prefix:temp_dir_name projdir + then EzFile.remove_dir ~all:true projdir + else Printf.eprintf "Leaving %s as is (does not look like a temporary \ + directory)" projdir; + (* Filter and print out results *) + EzString.split expected_output_string '\n' |> + List.filter_map begin function + | s when String.trim s = "" -> None (* ignore json RPC header: *) + | s when EzString.starts_with ~prefix:"Content-Length: " s -> None + | s -> Some (Str.global_replace projdir_regexp projdir_marker s) + end |> + String.concat "\n" |> + print_endline + in + (* Force project initialization (so we can flush before the next RPC) *) + ignore @@ LSP.Project.in_existing_dir projdir ~layout; + print_newline (); + { projdir; end_with_postproc }, make_server () + +(** {1 Cursor positions} *) + +(** Structure returned by {!extract_position_markers} below. *) +type positions = + { + pos_anonymous: Position.t list; + pos_map: Position.t StrMap.t; + } + +let position_marker = "_|_\\|_|[0-9a-zA-Z-+]+|_" +let position_or_newline_regexp = Str.(regexp @@ position_marker ^ "\\|\n") + +(** [extract_position_markers text] records and removes any cursor position + marker from [text], and returns the resulting text along with a set of + cursor positions. + + Anonymous markers are denoted {[_|_]}. They are listed in order of + appearance in [text] ([pos_anonymous]). + + Named markers are denoted {[_|some-name|_]}, where {[some-name]} may + comprise alphanumeric and [+] or [-] characters. They are recorded in + [pos_map]. *) +let extract_position_markers text = + let splits = Str.full_split position_or_newline_regexp text in + let acc, _, _, positions = + List.fold_left begin fun (acc, line, char, positions) -> function + | Str.Text t -> + t :: acc, line, char + String.length t, positions + | Str.Delim "\n" -> + "\n" :: acc, succ line, 0, positions + | Str.Delim "_|_" -> + acc, line, char, (line, char, None) :: positions + | Str.Delim d -> + let position_ident = Scanf.sscanf d "_|%s@|_" Fun.id in + acc, line, char, (line, char, Some position_ident) :: positions + end ([], 0, 0, []) splits + in + String.concat "" (List.rev acc), + List.fold_left begin fun acc (line, character, ident) -> + let pos = Lsp.Types.Position.create ~line ~character in + match ident with + | None -> { acc with pos_anonymous = pos :: acc.pos_anonymous } + | Some id -> { acc with pos_map = StrMap.add id pos acc.pos_map } + end { pos_anonymous = []; pos_map = StrMap.empty } positions + +(** {1 Helpers to reconstruct and print source locations} *) + +let srcloc_of_range ~uri : Range.t -> srcloc = + let pos_fname = Lsp.Uri.to_path uri in + let lines = EzFile.read_lines pos_fname in + let char_count = + Array.init (Array.length lines) (fun i -> String.length lines.(i)) in + ignore @@ Array.fold_left begin fun (idx, prev_count) line_length -> + char_count.(idx) <- line_length + prev_count + 1; (* + newline character *) + succ idx, char_count.(idx) + end (0, 0) char_count; + let lexpos_of_position Position.{ line; character } = + let pos_bol = if line = 0 then 0 else char_count.(line - 1) + and pos_lnum = line + 1 in + Lexing.{ pos_fname; pos_bol; pos_lnum; + pos_cnum = pos_bol + character } + in + fun Range.{ start; end_ } -> + let start_pos = lexpos_of_position start + and end_pos = lexpos_of_position end_ in + Cobol_common.Srcloc.raw (start_pos, end_pos) + +module UriCache = Ephemeron.K1.Make (Lsp.Uri) + +(* type srcloc_resuscitator = *) +(* { *) +(* srcloc_of_location: Location.t -> srcloc; *) +(* print_location: Location.t -> unit; *) +(* } *) + +(* let srcloc_resuscitator () = *) +(* let cache: (Range.t -> srcloc) UriCache.t = UriCache.create 1 in *) +(* let for_ ~uri = *) +(* try UriCache.find cache uri *) +(* with Not_found -> *) +(* let f = srcloc_of_range ~uri in *) +(* UriCache.replace cache uri f; *) +(* f *) +(* in *) +(* let srcloc_of_location Location.{ uri; range } = (for_ ~uri) range in *) +(* let print_location loc = *) +(* Pretty.out "%a@." Cobol_common.Srcloc.pp_srcloc (srcloc_of_location loc) *) +(* in *) +(* { *) +(* srcloc_of_location; *) +(* print_location; *) +(* } *) + +(** Helper class that encapsulates a cache so we do not always re-compute line + lengths and absolute character positions. (Looks much cleaner than the + equivalent code that is commented out above) *) +class srcloc_resuscitator_cache = object (self) + val cache: (Range.t -> srcloc) UriCache.t = + UriCache.create 1 + method private for_ ~uri = + try UriCache.find cache uri + with Not_found -> + let f = srcloc_of_range ~uri in + UriCache.replace cache uri f; + f + method of_ ~location:Location.{ uri; range } : srcloc = + (self#for_ ~uri) range + method print location = + Pretty.out "%a@." Cobol_common.Srcloc.pp_srcloc (self#of_ ~location) + method print_range_for ~uri range = + self#print (Location.create ~uri ~range) + method print_optional_range_for ~uri range = + Option.iter (self#print_range_for ~uri) range +end + +(* --- *) + +(* let%expect_test "initialize-server" = *) +(* ignore @@ LSP.Project.in_existing_dir projdir ~layout; *) +(* print_postproc [%expect.output]; *) +(* [%expect {| *) +(* {"params":{"diagnostics":[],"uri":"file://__rootdir__/superbol.toml"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"} *) +(* |}];; *) diff --git a/test/lsp/lsp_testing.mli b/test/lsp/lsp_testing.mli new file mode 100644 index 000000000..e4a9d064d --- /dev/null +++ b/test/lsp/lsp_testing.mli @@ -0,0 +1,41 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2021-2023 OCamlPro SAS *) +(* *) +(* All rights reserved. *) +(* This file is distributed under the terms of the *) +(* OCAMLPRO-NON-COMMERCIAL license. *) +(* *) +(**************************************************************************) + +module StrMap = EzCompat.StringMap +module LSP = Cobol_lsp.INTERNAL + +type test_project = + { + projdir: string; + end_with_postproc: string -> unit; + } + +val make_lsp_project + : ?toml:string + -> unit + -> test_project * LSP.Types.registry +val add_cobol_doc + : LSP.Types.registry -> ?copybook:bool -> projdir:string -> string -> string + -> LSP.Types.registry * Lsp.Types.TextDocumentIdentifier.t + +type positions = + { + pos_anonymous: Lsp.Types.Position.t list; + pos_map: Lsp.Types.Position.t EzCompat.StringMap.t; + } + +val extract_position_markers: string -> string * positions + +class srcloc_resuscitator_cache: object + method of_: location:Lsp.Types.Location.t -> Cobol_common.Srcloc.srcloc + method print: Lsp.Types.Location.t -> unit + method print_range_for: uri:Lsp.Uri.t -> Lsp.Types.Range.t -> unit + method print_optional_range_for: uri:Lsp.Uri.t -> Lsp.Types.Range.t option -> unit +end