Skip to content

Commit c556a20

Browse files
AnthonyLeonardoGracioAnthonyLeonardoGracio
committed
Merge branch 'topic/#1679' into 'master'
Handle textDocument/definition queries on 'is' token See merge request eng/ide/ada_language_server!2069
2 parents 06415b9 + accd2e1 commit c556a20

File tree

9 files changed

+803
-6
lines changed

9 files changed

+803
-6
lines changed

‎source/ada/lsp-ada_definition.adb‎

Lines changed: 128 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ with Libadalang.Common;
2424
with Laltools.Common;
2525

2626
with LSP.Ada_Context_Sets;
27+
with LSP.Ada_Documents;
2728
with LSP.Ada_Handlers.Locations;
2829
with LSP.Ada_Request_Jobs;
2930
with LSP.Client_Message_Receivers;
@@ -124,6 +125,132 @@ package body LSP.Ada_Definition is
124125
Decl_For_Find_Overrides : Libadalang.Analysis.Basic_Decl;
125126

126127
Ignore : Boolean;
128+
129+
procedure Retrieve_Alternate_Part_Location;
130+
-- Retrieve the location of the alternate part of a package, task,
131+
-- protected type, or subprogram.
132+
-- This is used when the user queries the definition of a token that
133+
-- does not belong to a defining name.
134+
-- If the queried token is equal to 'is', retrieve the location of the
135+
-- private part of the package, task, protected type, or the begin
136+
-- of the subprogram body.
137+
138+
procedure Retrieve_Alternate_Part_Location is
139+
use Libadalang.Common;
140+
141+
procedure Append_Prev_Token_Location
142+
(Node : Libadalang.Analysis.Ada_Node'Class);
143+
-- Append the previous token's location to the response.
144+
145+
-----------------------
146+
-- Append_Prev_Token --
147+
-----------------------
148+
149+
procedure Append_Prev_Token_Location
150+
(Node : Libadalang.Analysis.Ada_Node'Class) is
151+
begin
152+
if not Node.Is_Null then
153+
declare
154+
Prev : constant Libadalang.Common.Token_Reference :=
155+
Libadalang.Common.Previous (Node.Token_Start, True);
156+
begin
157+
Self.Parent.Context.Append_Location
158+
(Result => Self.Response,
159+
Filter => Self.Filter,
160+
Unit => Node.Unit,
161+
Token => Prev);
162+
end;
163+
end if;
164+
end Append_Prev_Token_Location;
165+
166+
Document : constant LSP.Ada_Documents.Document_Access :=
167+
Self.Parent.Context.Get_Open_Document (Value.textDocument.uri);
168+
Token : Libadalang.Common.Token_Reference :=
169+
Document.Get_Token_At (Context.all, Value.position);
170+
Node : Libadalang.Analysis.Ada_Node;
171+
Position : LSP.Structures.Position;
172+
begin
173+
if Token /= No_Token then
174+
if Token.Data.Kind = Ada_Is then
175+
Node := Document.Get_Node_At (Context => Context.all, Position => Value.position);
176+
177+
if not Node.Is_Null and then Node.Kind in Ada_Subp_Body_Range
178+
then
179+
-- We are on the 'is' of a subprogram body: retrieve the
180+
-- enclosing subprogram's defining name instead of checking
181+
-- for the previous token's node since it might refer to the
182+
-- subprogram's parameter list.
183+
Definition := Node.As_Subp_Body.P_Defining_Name;
184+
else
185+
-- We are on the 'is' of a package, task, or protected type: retrieve
186+
-- the previous token's node, which should be the defining name.
187+
Token := Token.Previous (True);
188+
189+
if Token = No_Token then
190+
-- Return if there is no previous token.
191+
return;
192+
end if;
193+
194+
Position :=
195+
Document.To_A_Range (Token.Data.Sloc_Range).start;
196+
Node :=
197+
Document.Get_Node_At
198+
(Context => Context.all, Position => Position);
199+
200+
Definition := Laltools.Common.Resolve_Name_Precisely (Node.As_Name);
201+
end if;
202+
203+
-- Append private part, begin locations to the response
204+
for Part of Definition.P_Basic_Decl.P_All_Parts loop
205+
case Part.Kind is
206+
207+
when Libadalang.Common.Ada_Package_Body_Range =>
208+
Append_Prev_Token_Location (Part.As_Package_Body.F_Stmts);
209+
210+
when Libadalang.Common.Ada_Subp_Body_Range =>
211+
Append_Prev_Token_Location (Part.As_Subp_Body.F_Stmts);
212+
213+
when Libadalang.Common.Ada_Task_Body_Range =>
214+
Append_Prev_Token_Location (Part.As_Task_Body.F_Stmts);
215+
216+
when Libadalang.Common.Ada_Base_Package_Decl =>
217+
Append_Prev_Token_Location
218+
(Part.As_Base_Package_Decl.F_Private_Part);
219+
220+
when Libadalang.Common.Ada_Protected_Type_Decl_Range =>
221+
Append_Prev_Token_Location
222+
(Part
223+
.As_Protected_Type_Decl
224+
.F_Definition
225+
.F_Private_Part);
226+
227+
when Libadalang.Common.Ada_Single_Protected_Decl_Range =>
228+
Append_Prev_Token_Location
229+
(Part
230+
.As_Single_Protected_Decl
231+
.F_Definition
232+
.F_Private_Part);
233+
234+
when Libadalang.Common.Ada_Task_Type_Decl_Range =>
235+
Append_Prev_Token_Location
236+
(Part.As_Task_Type_Decl.F_Definition.F_Private_Part);
237+
238+
when Libadalang.Common.Ada_Single_Task_Decl_Range =>
239+
Append_Prev_Token_Location
240+
(Part
241+
.As_Single_Task_Decl
242+
.F_Task_Type
243+
.F_Definition
244+
.F_Private_Part);
245+
246+
when others =>
247+
null;
248+
end case;
249+
end loop;
250+
end if;
251+
end if;
252+
end Retrieve_Alternate_Part_Location;
253+
127254
begin
128255
if Self.Contexts.Is_Empty then
129256
-- No more contexts to process, sort and return collected results
@@ -148,6 +275,7 @@ package body LSP.Ada_Definition is
148275
(Self.Parent.Context.Get_Node_At (Context.all, Value));
149276

150277
if Name_Node.Is_Null then
278+
Retrieve_Alternate_Part_Location;
151279
return;
152280
end if;
153281

‎source/ada/lsp-ada_handlers-locations.adb‎

Lines changed: 35 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -32,9 +32,41 @@ package body LSP.Ada_Handlers.Locations is
3232
return LSP.Structures.A_Range;
3333

3434
function From_LSP_Range
35-
(Unit : Libadalang.Analysis.Analysis_Unit;
36-
Sloc : LSP.Structures.A_Range)
37-
return Langkit_Support.Slocs.Source_Location_Range;
35+
(Unit : Libadalang.Analysis.Analysis_Unit; Sloc : LSP.Structures.A_Range)
36+
return Langkit_Support.Slocs.Source_Location_Range;
37+
38+
---------------------
39+
-- Append_Location --
40+
---------------------
41+
42+
procedure Append_Location
43+
(Self : in out Message_Handler;
44+
Result : in out LSP.Structures.Location_Vector;
45+
Filter : in out LSP.Locations.File_Span_Sets.Set;
46+
Unit : Libadalang.Analysis.Analysis_Unit;
47+
Token : Libadalang.Common.Token_Reference)
48+
is
49+
use type Libadalang.Common.Token_Reference;
50+
begin
51+
if Token /= Libadalang.Common.No_Token then
52+
declare
53+
URI : constant LSP.Structures.DocumentUri :=
54+
(VSS.Strings.Conversions.To_Virtual_String
55+
(URIs.Conversions.From_File (Unit.Get_Filename))
56+
with null record);
57+
58+
Value : constant LSP.Structures.Location :=
59+
(uri => URI,
60+
a_range => Locations.To_LSP_Range (Self, Unit, Token),
61+
alsKind => LSP.Constants.Empty);
62+
begin
63+
if not Filter.Contains (Value) then
64+
Result.Append (Value);
65+
Filter.Insert (Value);
66+
end if;
67+
end;
68+
end if;
69+
end Append_Location;
3870

3971
---------------------
4072
-- Append_Location --

‎source/ada/lsp-ada_handlers-locations.ads‎

Lines changed: 9 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,8 +69,15 @@ package LSP.Ada_Handlers.Locations is
6969
return Libadalang.Analysis.Ada_Node;
7070

7171
function Start_Position
72-
(Token : Libadalang.Common.Token_Reference)
73-
return LSP.Structures.Position;
72+
(Token : Libadalang.Common.Token_Reference) return LSP.Structures.Position;
73+
74+
procedure Append_Location
75+
(Self : in out Message_Handler;
76+
Result : in out LSP.Structures.Location_Vector;
77+
Filter : in out LSP.Locations.File_Span_Sets.Set;
78+
Unit : Libadalang.Analysis.Analysis_Unit;
79+
Token : Libadalang.Common.Token_Reference);
80+
-- Append the location corresponding to the given token to the Result.
7481

7582
procedure Append_Location
7683
(Self : in out Message_Handler;

‎source/ada/lsp-ada_handlers.adb‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -197,6 +197,14 @@ package body LSP.Ada_Handlers is
197197
Kinds : AlsReferenceKind_Array := LSP.Constants.Empty)
198198
renames LSP.Ada_Handlers.Locations.Append_Location;
199199

200+
overriding procedure Append_Location
201+
(Self : in out Message_Handler;
202+
Result : in out LSP.Structures.Location_Vector;
203+
Filter : in out LSP.Locations.File_Span_Sets.Set;
204+
Unit : Libadalang.Analysis.Analysis_Unit;
205+
Token : Libadalang.Common.Token_Reference)
206+
renames LSP.Ada_Handlers.Locations.Append_Location;
207+
200208
function Project_Predefined_Units
201209
(Self : in out Message_Handler; Context : LSP.Ada_Contexts.Context)
202210
return Libadalang.Analysis.Analysis_Unit_Array;

‎source/ada/lsp-ada_handlers.ads‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -571,6 +571,13 @@ private
571571
Node : Libadalang.Analysis.Ada_Node'Class;
572572
Kinds : LSP.Structures.AlsReferenceKind_Set := LSP.Constants.Empty);
573573

574+
overriding procedure Append_Location
575+
(Self : in out Message_Handler;
576+
Result : in out LSP.Structures.Location_Vector;
577+
Filter : in out LSP.Locations.File_Span_Sets.Set;
578+
Unit : Libadalang.Analysis.Analysis_Unit;
579+
Token : Libadalang.Common.Token_Reference);
580+
574581
overriding procedure Trace_Exception
575582
(Self : Message_Handler;
576583
Error : Ada.Exceptions.Exception_Occurrence;

‎source/ada/lsp-ada_job_contexts.ads‎

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@
1010
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
1111
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public --
1212
-- License for more details. You should have received a copy of the GNU --
13-
-- General Public License distributed with this software; see file --
13+
-- General Public License distributed with this software;z see file --
1414
-- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy --
1515
-- of the license. --
1616
------------------------------------------------------------------------------
@@ -196,6 +196,15 @@ package LSP.Ada_Job_Contexts is
196196
-- Append given Node location to the Result.
197197
-- Do nothing if the item inside of an synthetic file (like __standard).
198198

199+
procedure Append_Location
200+
(Self : in out Ada_Job_Context;
201+
Result : in out LSP.Structures.Location_Vector;
202+
Filter : in out LSP.Locations.File_Span_Sets.Set;
203+
Unit : Libadalang.Analysis.Analysis_Unit;
204+
Token : Libadalang.Common.Token_Reference)
205+
is abstract;
206+
-- Append given token location to the Result.
207+
199208
procedure Trace_Exception
200209
(Self : Ada_Job_Context;
201210
Error : Ada.Exceptions.Exception_Occurrence;

‎testsuite/ada_lsp/definition_begin_private/main.adb‎

Lines changed: 92 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,92 @@
1+
procedure Main is
2+
package Pkg is
3+
X : Integer;
4+
private
5+
function Y return Integer;
6+
end Pkg;
7+
8+
package body Pkg is
9+
Z : Integer;
10+
11+
function Y return Integer is
12+
begin
13+
return (Z);
14+
end Y;
15+
16+
begin
17+
Z := 0;
18+
end Pkg;
19+
20+
protected type Pr_Type is
21+
procedure Proc;
22+
private
23+
procedure Priv;
24+
end Pr_Type;
25+
26+
protected body Pr_Type is
27+
procedure Proc is
28+
begin
29+
Priv;
30+
end Proc;
31+
32+
procedure Priv is
33+
begin
34+
null;
35+
end Priv;
36+
end Pr_Type;
37+
38+
protected Pr_Obj is
39+
procedure Proc;
40+
private
41+
procedure Priv;
42+
end Pr_Obj;
43+
44+
protected body Pr_Obj is
45+
procedure Proc is
46+
begin
47+
Priv;
48+
end Proc;
49+
50+
procedure Priv is
51+
begin
52+
null;
53+
end Priv;
54+
end Pr_Obj;
55+
56+
task type Task_Type is
57+
pragma Page;
58+
private
59+
entry Entr;
60+
end Task_Type;
61+
62+
task body Task_Type is
63+
X : Integer;
64+
begin
65+
loop
66+
accept Entr;
67+
end loop;
68+
end Task_Type;
69+
70+
task Task_Obj is
71+
pragma Page;
72+
private
73+
entry Entr;
74+
end Task_Obj;
75+
76+
task body Task_Obj is
77+
X : Integer;
78+
begin
79+
loop
80+
accept Entr;
81+
end loop;
82+
end Task_Obj;
83+
84+
procedure Local (A : Integer) is
85+
X : Integer;
86+
begin
87+
X := A;
88+
end Local;
89+
90+
begin
91+
null;
92+
end Main;

0 commit comments

Comments
 (0)