feat: added qualificators to data and proc refs

this fixes rename on parent field
OCamlPro · Aug 13, 2024 · 1d1d255 · 1d1d255
1 parent f7248c7
commit 1d1d255
Show file tree

Hide file tree

Showing 6 changed files with 367 additions and 56 deletions.
diff --git a/src/lsp/cobol_typeck/typeck_outputs.ml b/src/lsp/cobol_typeck/typeck_outputs.ml
@@ -20,6 +20,12 @@ type references_in_unit =
     data_refs: qualrefmap;
     proc_refs: qualrefmap;
     (* TODO: const_refs, prog_refs?, others... *)
+    (* TODO atm data_refs and proc_refs contains BOTH direct references and indirect references
+       e.g.: DISPLAY B IN A result in
+         - a direct reference to B
+         - a indirect reference to A
+      In the future we may need/want to split those 2 kind of references
+     *)
   }
 type references_in_group = references_in_unit Cobol_unit.Collections.MAP.t
 

diff --git a/src/lsp/cobol_typeck/typeck_procedure.ml b/src/lsp/cobol_typeck/typeck_procedure.ml
@@ -187,7 +187,7 @@ let references ~(data_definitions: Cobol_unit.Types.data_definitions) procedure
 
     method! fold_qualname qn acc =                (* TODO: data_name' instead *)
       let loc = baseloc_of_qualname qn in
-      Visitor.skip_children @@
+      Visitor.do_children @@
       (* match Qualmap.find qn data_definitions.data_items.named with *)
       (* | Data_field { def; _ } -> *)
       (*     { acc with *)
@@ -226,18 +226,27 @@ let references ~(data_definitions: Cobol_unit.Types.data_definitions) procedure
       Cobol_ptree.Proc_division_visitor.fold_paragraph' v paragraph acc
 
 
-    method! fold_procedure_name' ({ loc; _ } as qn)
+    method! fold_procedure_name' qn
         ({ current_section = in_section; _ } as acc) =
-      Visitor.skip_children @@
-      match Cobol_unit.Procedure.find ~&qn ?in_section procedure with
-      | block ->
+      let register ?in_section qn acc =
+        let loc = baseloc_of_qualname ~&qn in
+        match Cobol_unit.Procedure.find ~&qn ?in_section procedure with
+        | block ->
           { acc with
             refs = Typeck_outputs.register_procedure_ref ~loc block acc.refs }
-      | exception Not_found ->
+        | exception Not_found ->
           error acc @@ Unknown_proc_name qn
-      | exception Qualmap.Ambiguous (lazy matching_qualnames) ->
+        | exception Qualmap.Ambiguous (lazy matching_qualnames) ->
           error acc @@ Ambiguous_proc_name { given_qualname = qn;
-                                             matching_qualnames }
+                                             matching_qualnames } in
+      register ?in_section qn acc
+      |> begin match ~&qn with
+        | Name _ -> Fun.id
+        | Qual (_, section_qn) ->
+          let loc = baseloc_of_qualname section_qn in
+          register (section_qn &@ loc)
+      end
+      |> Visitor.skip_children
 
   end in
 

diff --git a/test/lsp/lsp_codelens.ml b/test/lsp/lsp_codelens.ml
@@ -47,6 +47,7 @@ let%expect_test "codelens" =
           88 YYcond value "a".
         PROCEDURE DIVISION.
             MOVE aa TO aA.
+            DISPLAY BB IN AA.
             STOP RUN.
     |cobol} in
   end_with_postproc [%expect.output];
@@ -60,7 +61,7 @@ let%expect_test "codelens" =
     ----              ^
        7             02 BB PIC X.
        8             02 BBprime REDEFINES BB PIC 9.
-    3 references
+    4 references
     __rootdir__/prog.cob:7.13:
        4           DATA DIVISION.
        5           WORKING-STORAGE SECTION.
@@ -69,7 +70,7 @@ let%expect_test "codelens" =
     ----                ^
        8             02 BBprime REDEFINES BB PIC 9.
        9             02 CC PIC X. 02 DD PIC X.
-    3 references
+    4 references
     __rootdir__/prog.cob:8.13:
        5           WORKING-STORAGE SECTION.
        6           01 AA.
@@ -154,7 +155,7 @@ let%expect_test "codelens-procedure" =
             CC.
             DD SECTION.
             PERFORM AA.
-            PERFORM BB.
+            PERFORM BB IN AA.
             GO DD.
             STOP RUN.
     |cobol} in
@@ -169,7 +170,7 @@ let%expect_test "codelens-procedure" =
     ----               ^
        6               BB.
        7               PERFORM BB.
-    2 references
+    3 references
     __rootdir__/prog.cob:6.12:
        3           PROGRAM-ID. prog.
        4           PROCEDURE DIVISION.
@@ -195,5 +196,5 @@ let%expect_test "codelens-procedure" =
        9 >             DD SECTION.
     ----               ^
       10               PERFORM AA.
-      11               PERFORM BB.
+      11               PERFORM BB IN AA.
     2 references |}];;
diff --git a/test/lsp/lsp_definition.ml b/test/lsp/lsp_definition.ml
@@ -638,11 +638,11 @@ let%expect_test "definition-index" =
            SET _|3-i|_I IN V-TAB TO 0
            SET _|4-j|_J IN w TO 0
            SET _|5-k|_K IN W-TAB IN W TO 0
-           SET _|6-missing|_L IN w-tab IN W TO 0
+           SET _|6-missing|_L IN w-tab IN W TO 0.
   |cobol};
   end_with_postproc [%expect.output];
   [%expect {|
-    {"params":{"diagnostics":[{"message":"Missing .","range":{"end":{"character":35,"line":11},"start":{"character":35,"line":11}},"severity":4}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
     1-j (line 4, character 41):
     __rootdir__/prog.cob:5.41-5.42:
        2          PROGRAM-ID. prog.

diff --git a/test/lsp/lsp_references.ml b/test/lsp/lsp_references.ml
@@ -302,3 +302,173 @@ let%expect_test "references-requests-filler" =
     ----                       ^
       14             STOP RUN.
       15 |}]
+
+let%expect_test "references-requests-group-var" =
+  let { end_with_postproc; projdir }, server = make_lsp_project () in
+  print_references ~projdir server @@ extract_position_markers {cobol|
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. prog.
+        DATA DIVISION.
+        WORKING-STORAGE SECTION.
+        01 _|parent-in-def|_A.
+          05 _|child-in-def|_B PIC 9.
+        PROCEDURE DIVISION.
+          DISPLAY _|parent-alone|_A.
+          DISPLAY _|child-alone|_B.
+          DISPLAY _|child-in-parent|_B IN _|parent-of-child|_A.
+          MOVE 1 TO X.
+          STOP RUN.
+    |cobol};
+  end_with_postproc [%expect.output];
+  [%expect {|
+    {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    child-alone (line 9, character 18):
+    __rootdir__/prog.cob:7.13-7.14:
+       4           DATA DIVISION.
+       5           WORKING-STORAGE SECTION.
+       6           01 A.
+       7 >           05 B PIC 9.
+    ----                ^
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+    __rootdir__/prog.cob:10.18-10.19:
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10 >           DISPLAY B.
+    ----                     ^
+      11             DISPLAY B IN A.
+      12             MOVE 1 TO X.
+    __rootdir__/prog.cob:11.18-11.19:
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10             DISPLAY B.
+      11 >           DISPLAY B IN A.
+    ----                     ^
+      12             MOVE 1 TO X.
+      13             STOP RUN.
+    child-in-def (line 6, character 13):
+    __rootdir__/prog.cob:7.13-7.14:
+       4           DATA DIVISION.
+       5           WORKING-STORAGE SECTION.
+       6           01 A.
+       7 >           05 B PIC 9.
+    ----                ^
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+    __rootdir__/prog.cob:10.18-10.19:
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10 >           DISPLAY B.
+    ----                     ^
+      11             DISPLAY B IN A.
+      12             MOVE 1 TO X.
+    __rootdir__/prog.cob:11.18-11.19:
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10             DISPLAY B.
+      11 >           DISPLAY B IN A.
+    ----                     ^
+      12             MOVE 1 TO X.
+      13             STOP RUN.
+    child-in-parent (line 10, character 18):
+    __rootdir__/prog.cob:7.13-7.14:
+       4           DATA DIVISION.
+       5           WORKING-STORAGE SECTION.
+       6           01 A.
+       7 >           05 B PIC 9.
+    ----                ^
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+    __rootdir__/prog.cob:10.18-10.19:
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10 >           DISPLAY B.
+    ----                     ^
+      11             DISPLAY B IN A.
+      12             MOVE 1 TO X.
+    __rootdir__/prog.cob:11.18-11.19:
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10             DISPLAY B.
+      11 >           DISPLAY B IN A.
+    ----                     ^
+      12             MOVE 1 TO X.
+      13             STOP RUN.
+    parent-alone (line 8, character 18):
+    __rootdir__/prog.cob:6.11-6.12:
+       3           PROGRAM-ID. prog.
+       4           DATA DIVISION.
+       5           WORKING-STORAGE SECTION.
+       6 >         01 A.
+    ----              ^
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+    __rootdir__/prog.cob:9.18-9.19:
+       6           01 A.
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+       9 >           DISPLAY A.
+    ----                     ^
+      10             DISPLAY B.
+      11             DISPLAY B IN A.
+    __rootdir__/prog.cob:11.23-11.24:
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10             DISPLAY B.
+      11 >           DISPLAY B IN A.
+    ----                          ^
+      12             MOVE 1 TO X.
+      13             STOP RUN.
+    parent-in-def (line 5, character 11):
+    __rootdir__/prog.cob:6.11-6.12:
+       3           PROGRAM-ID. prog.
+       4           DATA DIVISION.
+       5           WORKING-STORAGE SECTION.
+       6 >         01 A.
+    ----              ^
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+    __rootdir__/prog.cob:9.18-9.19:
+       6           01 A.
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+       9 >           DISPLAY A.
+    ----                     ^
+      10             DISPLAY B.
+      11             DISPLAY B IN A.
+    __rootdir__/prog.cob:11.23-11.24:
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10             DISPLAY B.
+      11 >           DISPLAY B IN A.
+    ----                          ^
+      12             MOVE 1 TO X.
+      13             STOP RUN.
+    parent-of-child (line 10, character 23):
+    __rootdir__/prog.cob:6.11-6.12:
+       3           PROGRAM-ID. prog.
+       4           DATA DIVISION.
+       5           WORKING-STORAGE SECTION.
+       6 >         01 A.
+    ----              ^
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+    __rootdir__/prog.cob:9.18-9.19:
+       6           01 A.
+       7             05 B PIC 9.
+       8           PROCEDURE DIVISION.
+       9 >           DISPLAY A.
+    ----                     ^
+      10             DISPLAY B.
+      11             DISPLAY B IN A.
+    __rootdir__/prog.cob:11.23-11.24:
+       8           PROCEDURE DIVISION.
+       9             DISPLAY A.
+      10             DISPLAY B.
+      11 >           DISPLAY B IN A.
+    ----                          ^
+      12             MOVE 1 TO X.
+      13             STOP RUN. |}]