Merge pull request #322 from NeoKaios/fix/failing-completion

Fix completion failing in some parser states
OCamlPro · Aug 12, 2024 · 15b985a · 15b985a
2 parents e5787b9 + 7990c5d
commit 15b985a
Show file tree

Hide file tree

Showing 5 changed files with 138 additions and 8 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -3,6 +3,7 @@
 ## [0.1.4] Next release
 
 ### Added
+- Completion for more grammar constructs [#322](https://github.com/OCamlPro/superbol-studio-oss/pull/322)
 - Support for LSP request `textDocument/codeLens` [#349](https://github.com/OCamlPro/superbol-studio-oss/pull/349)
 - Show display example of `NUMERIC-EDITED` data on hover [#337](https://github.com/OCamlPro/superbol-studio-oss/pull/337)
 - Support for dump and listing files, along with a task attribute for outputting the latter [#347](https://github.com/OCamlPro/superbol-studio-oss/pull/347)

diff --git a/src/lsp/cobol_lsp/lsp_completion.ml b/src/lsp/cobol_lsp/lsp_completion.ml
@@ -291,7 +291,11 @@ let expected_tokens ?(eager=true) base_env =
       CompEntrySet.add_seq (expected_comp_entries_in ~env ~eager) acc in
     Expect.actions_in ~env
     |> List.filter_map begin function
-      | Expect.Reduce prod -> Some ( Menhir.force_reduction prod env )
+      | Expect.Reduce prod ->
+        begin
+          try Some ( Menhir.force_reduction prod env )
+          with Invalid_argument _ -> None
+        end
       | Feed nt ->
         try
           let default_value = Expect.default_nonterminal_value nt in

diff --git a/src/lsp/cobol_lsp/lsp_lookup.ml b/src/lsp/cobol_lsp/lsp_lookup.ml
@@ -310,7 +310,8 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
           | AllocateDataItem n ->
             acc
             |> Any (* linkage level 01 or 77 *) @>@ fold_name' v n
-          | _ -> acc
+          | AllocateCharacters e ->
+            acc |> Any @>@ fold_expression v e
         end
         |> skip
 
@@ -325,7 +326,10 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
           | CallGeneral i ->
             acc
             |> Alphanum (* +procedure_pointer *) @>@ fold_ident_or_strlit v i
-          | _ -> acc
+          | CallProto { called; prototype } ->
+            acc
+            |> fold_option ~fold:fold_ident_or_strlit v called
+            |> fold_call_proto v prototype
         end
         |> skip
 
@@ -338,6 +342,7 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
         acc
         |> [Numeric; NumericEdited; Boolean]
         @>>@ fold_rounded_idents v c.compute_targets
+        |> Any @>@ fold_expr v c.compute_expr
         |> fold_dual_handler v c.compute_on_size_error
         |> skip
 
@@ -358,9 +363,9 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
       method! fold_entry_by_clause clause acc =
         begin match clause with
           | EntryByReference l ->
-            acc
-            |> Any (* linkage lvl 01 77*) @>@ fold_name'_list v l
-          | _ -> acc
+            acc |> Any (* linkage lvl 01 77*) @>@ fold_name'_list v l
+          | EntryByValue l ->
+            acc |> fold_name'_list v l
         end
         |> skip
 
@@ -381,12 +386,21 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
       method! fold_inspect' { payload = i; _ } acc =
         acc
         |> (* usage display *) fold_ident v i.inspect_item
+        |> fold_inspect_spec v i.inspect_spec
+        |> skip
+
+      method! fold_tallying t acc =
+        acc
+        |> Numeric @>@ fold_qualident v t.tallying_target
+        |> fold_list ~fold:fold_tallying_clause' v t.tallying_clauses
         |> skip
 
       method! fold_invoke' { payload = i; _ } acc =
         acc
         |> ObjectRef (* 4byte *) @>@ fold_ident v i.invoke_target
         |> Alphanum @>@ fold_ident_or_strlit v i.invoke_method
+        |> fold_list ~fold:fold_call_using_clause' v i.invoke_using
+        |> fold_ident'_opt v i.invoke_returning
         |> skip
 
       method! fold_move' { payload = m; _ } acc =
@@ -430,6 +444,7 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
         |> Numeric @>@ fold_ident v vp.varying_ident
         |> Numeric @>@ fold_scalar v vp.varying_from
         |> Numeric @>@ fold_option ~fold:fold_scalar v vp.varying_by
+        |> fold_condition v vp.varying_until
         |> skip
 
       method! fold_raise' { payload = r; _ } acc =
@@ -441,12 +456,17 @@ let type_at_pos ~filename (pos: Lsp.Types.Position.t) group : approx_typing_info
 
       method! fold_search' { payload = s; _ } acc =
         acc
+        |> fold_qualname v s.search_item
+        |> fold_handler v s.search_at_end
         |> [Numeric; Index] @>>@ fold_option ~fold:fold_ident v s.search_varying
+        |> fold_list ~fold:fold_search_when_clause' v s.search_when_clauses
         |> skip
 
       method! fold_string_stmt' { payload = s; _ } acc =
         acc
+        |> fold_list ~fold:fold_string_source v s.string_sources
         |> Alphanum @>@ fold_ident v s.string_target
+        |> fold_option ~fold:fold_ident v s.string_pointer
         |> fold_dual_handler v s.string_on_overflow
         |> skip
 

diff --git a/src/lsp/cobol_parser/expect/gen_expect.ml b/src/lsp/cobol_parser/expect/gen_expect.ml
@@ -531,6 +531,13 @@ module DEBUG = struct
             nullable kind
             (pp_list Print.terminal) (Nonterminal.first nonterm)))
 
+  let emit_productions_with_num ppf =
+    Production.iter begin fun production ->
+      Fmt.(
+        pf ppf "-%d- %a\n" (Production.to_int production)
+          Print.production production)
+    end
+
   let emit_state_productions ppf =
     Lr1.iter begin fun lr1 ->
       let lr0 = Lr1.lr0 lr1 in

diff --git a/test/lsp/lsp_completion.ml b/test/lsp/lsp_completion.ml
@@ -3888,10 +3888,12 @@ let%expect_test "semantic-while-writing-completion" =
           DISPLAY _|_
 
           UNSTRING _|_
+          UNSTRING ALPHA INTO _|_.
+          UNSTRING ALPHA INTO _|_ALPHA.
   |cobol} in
   end_with_postproc [%expect.output];
   [%expect {|
-    {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":2,"line":14},"start":{"character":0,"line":14}},"severity":1},{"message":"Missing <identifier> INTO .","range":{"end":{"character":18,"line":13},"start":{"character":18,"line":13}},"severity":4},{"message":"Invalid syntax","range":{"end":{"character":18,"line":13},"start":{"character":10,"line":13}},"severity":1},{"message":"Missing <identifier or literal>","range":{"end":{"character":17,"line":11},"start":{"character":17,"line":11}},"severity":4},{"message":"Invalid syntax","range":{"end":{"character":17,"line":11},"start":{"character":10,"line":11}},"severity":1},{"message":"Missing TO","range":{"end":{"character":13,"line":9},"start":{"character":13,"line":9}},"severity":4}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    {"params":{"diagnostics":[{"message":"Invalid syntax","range":{"end":{"character":31,"line":14},"start":{"character":30,"line":14}},"severity":1},{"message":"Invalid syntax","range":{"end":{"character":18,"line":14},"start":{"character":10,"line":14}},"severity":1},{"message":"Missing <identifier> INTO","range":{"end":{"character":18,"line":13},"start":{"character":18,"line":13}},"severity":4},{"message":"Invalid syntax","range":{"end":{"character":18,"line":13},"start":{"character":10,"line":13}},"severity":1},{"message":"Missing <identifier or literal>","range":{"end":{"character":17,"line":11},"start":{"character":17,"line":11}},"severity":4},{"message":"Invalid syntax","range":{"end":{"character":17,"line":11},"start":{"character":10,"line":11}},"severity":1},{"message":"Missing TO","range":{"end":{"character":13,"line":9},"start":{"character":13,"line":9}},"severity":4}],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
     __rootdir__/prog.cob:10.14:
        7           01 ALPHA PIC X.
        8           01 ANYY USAGE BIT.
@@ -3984,7 +3986,8 @@ let%expect_test "semantic-while-writing-completion" =
       13
       14 >           UNSTRING
     ----                      ^
-      15
+      15             UNSTRING ALPHA INTO .
+      16             UNSTRING ALPHA INTO ALPHA.
     (line 13, character 19):
     Basic (12 entries):
         NUM Numeric (unexpected here)
@@ -4011,6 +4014,75 @@ let%expect_test "semantic-while-writing-completion" =
         NULL
         PAGE-COUNTER
         SELF
+        SUPER
+    __rootdir__/prog.cob:15.30:
+      12             DISPLAY
+      13
+      14             UNSTRING
+      15 >           UNSTRING ALPHA INTO .
+    ----                                 ^
+      16             UNSTRING ALPHA INTO ALPHA.
+      17
+    (line 14, character 30):
+    Basic (12 entries):
+        NUM Numeric (unexpected here)
+        ALPHA Alphanum
+        ANYY Boolean (unexpected here)
+        ADDRESS
+        EXCEPTION-OBJECT
+        FUNCTION
+        LINAGE-COUNTER
+        LINE-COUNTER
+        NULL
+        PAGE-COUNTER
+        SELF
+        SUPER
+    Eager (12 entries):
+        NUM Numeric (unexpected here)
+        ALPHA Alphanum
+        ANYY Boolean (unexpected here)
+        ADDRESS OF
+        EXCEPTION-OBJECT
+        FUNCTION
+        LINAGE-COUNTER
+        LINE-COUNTER
+        NULL
+        PAGE-COUNTER
+        SELF
+        SUPER
+    __rootdir__/prog.cob:16.30:
+      13
+      14             UNSTRING
+      15             UNSTRING ALPHA INTO .
+      16 >           UNSTRING ALPHA INTO ALPHA.
+    ----                                 ^
+      17
+    (line 15, character 30):
+    Basic (12 entries):
+        NUM Numeric
+        ALPHA Alphanum
+        ANYY Boolean
+        ADDRESS
+        EXCEPTION-OBJECT
+        FUNCTION
+        LINAGE-COUNTER
+        LINE-COUNTER
+        NULL
+        PAGE-COUNTER
+        SELF
+        SUPER
+    Eager (12 entries):
+        NUM Numeric
+        ALPHA Alphanum
+        ANYY Boolean
+        ADDRESS OF
+        EXCEPTION-OBJECT
+        FUNCTION
+        LINAGE-COUNTER
+        LINE-COUNTER
+        NULL
+        PAGE-COUNTER
+        SELF
         SUPER |}];;
 
 let%expect_test "control-completion" =
@@ -5272,3 +5344,29 @@ let%expect_test "intrinsic-completion" =
         WITH NO ADVANCING
         WRITE
         ZEROS |}];;
+
+let%expect_test "string-concat-completion" =
+  let end_with_postproc = completion_positions @@ extract_position_markers {cobol|
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. prog.
+        DATA DIVISION.
+        WORKING-STORAGE SECTION.
+        01 CC PIC X.
+        PROCEDURE DIVISION.
+          MOVE "A"&"B" _|_TO CC.
+          STOP RUN.
+  |cobol} in
+  end_with_postproc [%expect.output];
+  [%expect{|
+    {"params":{"diagnostics":[],"uri":"file://__rootdir__/prog.cob"},"method":"textDocument/publishDiagnostics","jsonrpc":"2.0"}
+    __rootdir__/prog.cob:8.23:
+       5           WORKING-STORAGE SECTION.
+       6           01 CC PIC X.
+       7           PROCEDURE DIVISION.
+       8 >           MOVE "A"&"B" TO CC.
+    ----                          ^
+       9             STOP RUN.
+      10
+    (line 7, character 23):
+    Basic (1 entries): TO
+    Eager (1 entries): TO |}];;