Skip to content

Commit 189e83e

Browse files
AnthonyLeonardoGracioAnthonyLeonardoGracio
committed
VC16-002: Add use-clause completion provider
This provider proposes the use-clause corresponding to the with-clause on the same line, if any. A basic test has been added.
1 parent f886662 commit 189e83e

16 files changed

+786
-13
lines changed

‎source/ada/lsp-ada_completions-aspects.adb

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,9 @@ package body LSP.Ada_Completions.Aspects is
4040
Parent : constant Libadalang.Analysis.Ada_Node :=
4141
(if Node.Is_Null then Node else Node.Parent);
4242
begin
43-
if Parent.Kind in Libadalang.Common.Ada_Aspect_Assoc_Range then
43+
if not Parent.Is_Null and then
44+
Parent.Kind in Libadalang.Common.Ada_Aspect_Assoc_Range
45+
then
4446
declare
4547
Prefix : constant VSS.Strings.Virtual_String :=
4648
VSS.Strings.To_Virtual_String (Node.Text);

‎source/ada/lsp-ada_completions-filters.adb

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -129,6 +129,50 @@ package body LSP.Ada_Completions.Filters is
129129
return Self.Is_Attribute.Value;
130130
end Is_Attribute_Ref;
131131

132+
------------------
133+
-- Is_Semicolon --
134+
------------------
135+
136+
function Is_Semicolon (Self : in out Filter'Class) return Boolean is
137+
begin
138+
if not Self.Is_Semicolon.Is_Set then
139+
declare
140+
use all type Libadalang.Common.Token_Kind;
141+
142+
Token_Kind : constant Libadalang.Common.Token_Kind :=
143+
Kind (Self.Token);
144+
begin
145+
Self.Is_Semicolon :=
146+
(True,
147+
Token_Kind = Ada_Semicolon);
148+
end;
149+
end if;
150+
151+
return Self.Is_Semicolon.Value;
152+
end Is_Semicolon;
153+
154+
--------------
155+
-- Is_Comma --
156+
--------------
157+
158+
function Is_Comma (Self : in out Filter'Class) return Boolean is
159+
begin
160+
if not Self.Is_Comma.Is_Set then
161+
declare
162+
use all type Libadalang.Common.Token_Kind;
163+
164+
Token_Kind : constant Libadalang.Common.Token_Kind :=
165+
Kind (Self.Token);
166+
begin
167+
Self.Is_Comma :=
168+
(True,
169+
Token_Kind = Ada_Comma);
170+
end;
171+
end if;
172+
173+
return Self.Is_Comma.Value;
174+
end Is_Comma;
175+
132176
------------------------
133177
-- Is_Numeric_Literal --
134178
------------------------

‎source/ada/lsp-ada_completions-filters.ads

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,12 @@ package LSP.Ada_Completions.Filters is
3939
function Is_Attribute_Ref (Self : in out Filter'Class) return Boolean;
4040
-- Check if we complete "'<attribute>" text
4141

42+
function Is_Semicolon (Self : in out Filter'Class) return Boolean;
43+
-- Check if we complete right after ";"
44+
45+
function Is_Comma (Self : in out Filter'Class) return Boolean;
46+
-- Check if we complete right after ","
47+
4248
private
4349

4450
type Filter is tagged limited record
@@ -47,6 +53,8 @@ private
4753
Is_End_Label : LSP.Types.Optional_Boolean;
4854
Is_Numeric_Literal : LSP.Types.Optional_Boolean;
4955
Is_Attribute : LSP.Types.Optional_Boolean;
56+
Is_Semicolon : LSP.Types.Optional_Boolean;
57+
Is_Comma : LSP.Types.Optional_Boolean;
5058
end record;
5159

5260
end LSP.Ada_Completions.Filters;

‎source/ada/lsp-ada_completions-pragmas.adb

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,9 @@ package body LSP.Ada_Completions.Pragmas is
4040
Parent : constant Libadalang.Analysis.Ada_Node :=
4141
(if Node.Is_Null then Node else Node.Parent);
4242
begin
43-
if Parent.Kind in Libadalang.Common.Ada_Pragma_Node_Range then
43+
if not Parent.Is_Null and then
44+
Parent.Kind in Libadalang.Common.Ada_Pragma_Node_Range
45+
then
4446
declare
4547
Prefix : constant VSS.Strings.Virtual_String :=
4648
VSS.Strings.To_Virtual_String (Node.Text);

‎source/ada/lsp-ada_completions-use_clauses.adb

Lines changed: 125 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,125 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2018-2023, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
18+
with VSS.Strings.Conversions;
19+
with Libadalang.Iterators;
20+
with LSP.Ada_Completions.Filters;
21+
22+
package body LSP.Ada_Completions.Use_Clauses is
23+
24+
------------------------
25+
-- Propose_Completion --
26+
------------------------
27+
28+
overriding procedure Propose_Completion
29+
(Self : Use_Clause_Completion_Provider;
30+
Sloc : Langkit_Support.Slocs.Source_Location;
31+
Token : Libadalang.Common.Token_Reference;
32+
Node : Libadalang.Analysis.Ada_Node;
33+
Filter : in out LSP.Ada_Completions.Filters.Filter;
34+
Names : in out Ada_Completions.Completion_Maps.Map;
35+
Result : in out LSP.Messages.CompletionList)
36+
is
37+
use Libadalang.Common;
38+
use Langkit_Support.Slocs;
39+
use VSS.Strings;
40+
41+
function Has_With_Clause_Node
42+
(N : Libadalang.Analysis.Ada_Node) return Boolean;
43+
-- Returns true if we have a with-clause node on the same line
44+
45+
--------------------------
46+
-- Has_With_Clause_Node --
47+
--------------------------
48+
49+
function Has_With_Clause_Node
50+
(N : Libadalang.Analysis.Ada_Node) return Boolean
51+
is
52+
(N.Sloc_Range.Start_Line = Sloc.Line
53+
and then N.Kind = Ada_With_Clause);
54+
55+
With_Node : constant Libadalang.Analysis.Ada_Node :=
56+
Libadalang.Iterators.Find_First
57+
(Node.Unit.Root, Has_With_Clause_Node'Unrestricted_Access);
58+
begin
59+
-- Return immediately if we don't have any with-clause node on the same
60+
-- line or if we are still within the with-clause node.
61+
if With_Node.Is_Null
62+
or else Filter.Is_Comma
63+
or else
64+
(not Filter.Is_Semicolon
65+
and then (Sloc.Line = With_Node.Sloc_Range.End_Line
66+
and then Sloc.Column = With_Node.Sloc_Range.End_Column))
67+
then
68+
return;
69+
end if;
70+
71+
-- Get the package names refered in the with-clause and create the
72+
-- corresponding use-clause completion item.
73+
declare
74+
Packages : constant Libadalang.Analysis.Name_List :=
75+
With_Node.As_With_Clause.F_Packages;
76+
Insert_Text : VSS.Strings.Virtual_String :=
77+
VSS.Strings.Conversions.To_Virtual_String ("use ");
78+
Doc_Text : constant VSS.Strings.Virtual_String :=
79+
VSS.Strings.Conversions.To_Virtual_String
80+
("Insert the use-clause corresponding to the with-clause on "
81+
& "the same line.");
82+
Item : LSP.Messages.CompletionItem;
83+
Count : Positive := 1;
84+
begin
85+
for Package_Name of Packages loop
86+
Insert_Text := Insert_Text & VSS.Strings.To_Virtual_String
87+
(Package_Name.Text);
88+
89+
if Count < Packages.Children_Count then
90+
Insert_Text := Insert_Text & ", ";
91+
end if;
92+
93+
Count := Count + 1;
94+
end loop;
95+
96+
Insert_Text := Insert_Text & ";";
97+
98+
Item :=
99+
(label => Insert_Text,
100+
kind => (True, LSP.Messages.Unit),
101+
tags => (Is_Set => False),
102+
detail => (Is_Set => False),
103+
documentation =>
104+
(Is_Set => True,
105+
Value => LSP.Messages.String_Or_MarkupContent'
106+
(Is_String => True,
107+
String => Doc_Text)),
108+
deprecated => (Is_Set => False),
109+
preselect => (True, False),
110+
sortText => (True, "+" & Insert_Text),
111+
filterText => (Is_Set => False),
112+
insertText => (True, Insert_Text),
113+
insertTextFormat => (Is_Set => False),
114+
insertTextMode => (Is_Set => False),
115+
textEdit => (Is_Set => False),
116+
additionalTextEdits => <>,
117+
commitCharacters => (Is_Set => False),
118+
command => (Is_Set => False),
119+
data => (Is_Set => False));
120+
121+
Result.items.Append (Item);
122+
end;
123+
end Propose_Completion;
124+
125+
end LSP.Ada_Completions.Use_Clauses;

‎source/ada/lsp-ada_completions-use_clauses.ads

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2018-2023, AdaCore --
5+
-- --
6+
-- This is free software; you can redistribute it and/or modify it under --
7+
-- terms of the GNU General Public License as published by the Free Soft- --
8+
-- ware Foundation; either version 3, or (at your option) any later ver- --
9+
-- sion. This software is distributed in the hope that it will be useful, --
10+
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
11+
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
12+
-- License for more details. You should have received a copy of the GNU --
13+
-- General Public License distributed with this software; see file --
14+
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
15+
-- of the license. --
16+
------------------------------------------------------------------------------
17+
-- A completion provider for use-clauses
18+
19+
package LSP.Ada_Completions.Use_Clauses is
20+
21+
type Use_Clause_Completion_Provider is
22+
new Completion_Provider with null record;
23+
24+
overriding procedure Propose_Completion
25+
(Self : Use_Clause_Completion_Provider;
26+
Sloc : Langkit_Support.Slocs.Source_Location;
27+
Token : Libadalang.Common.Token_Reference;
28+
Node : Libadalang.Analysis.Ada_Node;
29+
Filter : in out LSP.Ada_Completions.Filters.Filter;
30+
Names : in out Ada_Completions.Completion_Maps.Map;
31+
Result : in out LSP.Messages.CompletionList);
32+
-- Get completion for use-clauses if we have a with-clause node on the
33+
-- same line.
34+
35+
end LSP.Ada_Completions.Use_Clauses;

‎source/ada/lsp-ada_documents.adb

Lines changed: 20 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@
1616
------------------------------------------------------------------------------
1717

1818
with Ada.Characters.Wide_Wide_Latin_1;
19+
with Ada.Tags;
1920
with Ada.Unchecked_Deallocation;
2021

2122
with GNAT.Strings;
@@ -2837,8 +2838,8 @@ package body LSP.Ada_Documents is
28372838

28382839
Filter : LSP.Ada_Completions.Filters.Filter;
28392840
begin
2840-
if Parent.Is_Null
2841-
or else (Parent.Kind not in
2841+
if not Parent.Is_Null
2842+
and then (Parent.Kind not in
28422843
Libadalang.Common.Ada_Dotted_Name | Libadalang.Common.Ada_End_Name
28432844
and then Node.Kind in Libadalang.Common.Ada_String_Literal_Range)
28442845
then
@@ -2854,13 +2855,23 @@ package body LSP.Ada_Documents is
28542855
Filter.Initialize (Token, Node);
28552856

28562857
for Provider of Providers loop
2857-
Provider.Propose_Completion
2858-
(Sloc => Sloc,
2859-
Token => Token,
2860-
Node => Node,
2861-
Filter => Filter,
2862-
Names => Names,
2863-
Result => Result);
2858+
begin
2859+
Provider.Propose_Completion
2860+
(Sloc => Sloc,
2861+
Token => Token,
2862+
Node => Node,
2863+
Filter => Filter,
2864+
Names => Names,
2865+
Result => Result);
2866+
2867+
exception
2868+
when E : Libadalang.Common.Property_Error =>
2869+
LSP.Common.Log
2870+
(Context.Trace,
2871+
E,
2872+
"LAL EXCEPTION occurred with following completion provider: "
2873+
& Ada.Tags.Expanded_Name (Provider'Tag));
2874+
end;
28642875
end loop;
28652876

28662877
Context.Trace.Trace

‎source/ada/lsp-ada_handlers.adb

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ with LSP.Ada_Completions.Keywords;
4747
with LSP.Ada_Completions.Names;
4848
with LSP.Ada_Completions.Parameters;
4949
with LSP.Ada_Completions.Pragmas;
50+
with LSP.Ada_Completions.Use_Clauses;
5051
with LSP.Ada_Handlers.Invisibles;
5152
with LSP.Ada_Handlers.Named_Parameters_Commands;
5253
with LSP.Ada_Handlers.Refactor_Change_Parameter_Mode;
@@ -5657,7 +5658,8 @@ package body LSP.Ada_Handlers is
56575658
Compute_Doc_And_Details => Compute_Doc_And_Details,
56585659
Named_Notation_Threshold => Self.Named_Notation_Threshold);
56595660
P8 : aliased LSP.Ada_Completions.End_Names.End_Name_Completion_Provider;
5660-
5661+
P9 : aliased
5662+
LSP.Ada_Completions.Use_Clauses.Use_Clause_Completion_Provider;
56615663
Providers : constant LSP.Ada_Completions.Completion_Provider_List :=
56625664
[P1'Unchecked_Access,
56635665
P2'Unchecked_Access,
@@ -5666,7 +5668,8 @@ package body LSP.Ada_Handlers is
56665668
P5'Unchecked_Access,
56675669
P6'Unchecked_Access,
56685670
P7'Unchecked_Access,
5669-
P8'Unchecked_Access];
5671+
P8'Unchecked_Access,
5672+
P9'Unchecked_Access];
56705673

56715674
Response : LSP.Messages.Server_Responses.Completion_Response
56725675
(Is_Error => False);

‎testsuite/ada_lsp/completion.use_clauses.multiple_with/default.gpr

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,2 @@
1+
project Default is
2+
end Default;

‎testsuite/ada_lsp/completion.use_clauses.multiple_with/main.adb

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
with Ada.Text_IO, GNAT.Strings;
2+
3+
procedure Main is
4+
begin
5+
Ada.Text_IO.Put_Line ("Hello");
6+
end Main;

0 commit comments

Comments
 (0)