Skip to content

Commit b7306d9

Browse files
AnthonyLeonardoGracioAnthonyLeonardoGracio
committed
Merge branch 'topic/merge_master_to_edge' into 'edge'
Merge master to edge See merge request eng/ide/ada_language_server!1526
2 parents 6cb2c1e + 1728337 commit b7306d9

12 files changed

+508
-254
lines changed

‎source/ada/lsp-ada_definition.adb

Lines changed: 279 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,279 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2024, 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 GNATCOLL.Traces;
19+
with GNATCOLL.VFS;
20+
21+
with Libadalang.Analysis;
22+
with Libadalang.Common;
23+
24+
with Laltools.Common;
25+
26+
with LSP.Ada_Context_Sets;
27+
with LSP.Ada_Handlers.Locations;
28+
with LSP.Client_Message_Receivers;
29+
with LSP.Enumerations;
30+
with LSP.Locations;
31+
with LSP.Server_Request_Jobs;
32+
with LSP.Server_Requests.Definition;
33+
with LSP.Structures;
34+
35+
package body LSP.Ada_Definition is
36+
37+
subtype AlsReferenceKind_Array is LSP.Structures.AlsReferenceKind_Set;
38+
39+
function Is_Parent return AlsReferenceKind_Array is
40+
([LSP.Enumerations.parent => True, others => False]);
41+
42+
function Is_Child return AlsReferenceKind_Array is
43+
([LSP.Enumerations.child => True, others => False]);
44+
45+
type Ada_Definition_Job
46+
(Parent : not null access constant Ada_Definition_Handler) is limited
47+
new LSP.Server_Request_Jobs.Server_Request_Job
48+
(Priority => LSP.Server_Jobs.High)
49+
with record
50+
Response : LSP.Structures.Location_Vector;
51+
Filter : LSP.Locations.File_Span_Sets.Set;
52+
Contexts : LSP.Ada_Context_Sets.Context_Lists.List;
53+
end record;
54+
55+
type Ada_Definition_Job_Access is access all Ada_Definition_Job;
56+
57+
overriding procedure Execute_Request
58+
(Self : in out Ada_Definition_Job;
59+
Client :
60+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
61+
Status : out LSP.Server_Jobs.Execution_Status);
62+
63+
----------------
64+
-- Create_Job --
65+
----------------
66+
67+
overriding function Create_Job
68+
(Self : Ada_Definition_Handler;
69+
Message : LSP.Server_Messages.Server_Message_Access)
70+
return LSP.Server_Jobs.Server_Job_Access
71+
is
72+
Value : LSP.Server_Requests.Definition.Request
73+
renames LSP.Server_Requests.Definition.Request
74+
(Message.all);
75+
76+
File : constant GNATCOLL.VFS.Virtual_File :=
77+
Self.Context.To_File (Value.Params.textDocument.uri);
78+
79+
Result : constant Ada_Definition_Job_Access :=
80+
new Ada_Definition_Job'
81+
(Parent => Self'Unchecked_Access,
82+
Request => LSP.Server_Request_Jobs.Request_Access (Message),
83+
others => <>);
84+
begin
85+
Result.Contexts := Self.Context.Contexts_For_File (File);
86+
87+
return LSP.Server_Jobs.Server_Job_Access (Result);
88+
end Create_Job;
89+
90+
---------------------
91+
-- Execute_Request --
92+
---------------------
93+
94+
overriding procedure Execute_Request
95+
(Self : in out Ada_Definition_Job;
96+
Client :
97+
in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
98+
Status : out LSP.Server_Jobs.Execution_Status)
99+
is
100+
use all type LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy;
101+
102+
Message : LSP.Server_Requests.Definition.Request
103+
renames LSP.Server_Requests.Definition.Request (Self.Message.all);
104+
105+
Value : LSP.Structures.DefinitionParams renames Message.Params;
106+
107+
Context : LSP.Ada_Context_Sets.Context_Access;
108+
109+
Display_Method_Policy : constant
110+
LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy :=
111+
(if Value.alsDisplayMethodAncestryOnNavigation.Is_Set
112+
then Value.alsDisplayMethodAncestryOnNavigation.Value
113+
else Self.Parent.Context.Get_Configuration
114+
.Display_Method_Ancestry_Policy);
115+
116+
Trace : constant GNATCOLL.Traces.Trace_Handle :=
117+
Self.Parent.Context.Get_Trace_Handle;
118+
119+
Name_Node : Libadalang.Analysis.Name;
120+
Definition : Libadalang.Analysis.Defining_Name;
121+
Other_Part : Libadalang.Analysis.Defining_Name;
122+
Manual_Fallback : Libadalang.Analysis.Defining_Name;
123+
Definition_Node : Libadalang.Analysis.Basic_Decl;
124+
Decl_For_Find_Overrides : Libadalang.Analysis.Basic_Decl;
125+
Entry_Decl_Node : Libadalang.Analysis.Entry_Decl;
126+
127+
Ignore : Boolean;
128+
begin
129+
if Self.Contexts.Is_Empty then
130+
-- No more contexts to process, sort and return collected results
131+
LSP.Ada_Handlers.Locations.Sort (Self.Response);
132+
133+
Client.On_Definition_Response
134+
(Message.Id,
135+
(Kind => LSP.Structures.Variant_1,
136+
Variant_1 => Self.Response));
137+
138+
Status := LSP.Server_Jobs.Done;
139+
140+
return;
141+
else
142+
Status := LSP.Server_Jobs.Continue;
143+
end if;
144+
145+
Context := Self.Contexts.First_Element;
146+
Self.Contexts.Delete_First;
147+
148+
Name_Node := Laltools.Common.Get_Node_As_Name
149+
(Self.Parent.Context.Get_Node_At (Context.all, Value));
150+
151+
if Name_Node.Is_Null then
152+
return;
153+
end if;
154+
155+
-- Check if we are on some defining name
156+
Definition := Laltools.Common.Get_Name_As_Defining (Name_Node);
157+
158+
if Definition.Is_Null then
159+
Definition := Self.Parent.Context.Imprecise_Resolve_Name (Name_Node);
160+
161+
if not Definition.Is_Null then
162+
Self.Parent.Context.Append_Location
163+
(Self.Response,
164+
Self.Filter,
165+
Definition);
166+
167+
if Display_Method_Policy in Usage_And_Abstract_Only | Always then
168+
Decl_For_Find_Overrides := Definition.P_Basic_Decl;
169+
end if;
170+
end if;
171+
else -- If we are on a defining_name already
172+
Other_Part := Laltools.Common.Find_Next_Part (Definition, Trace);
173+
174+
Definition_Node := Definition.P_Basic_Decl;
175+
176+
-- Search for overriding subprograms only if we are on an
177+
-- abstract subprogram.
178+
if Display_Method_Policy /= Never
179+
and then
180+
(Display_Method_Policy /= Usage_And_Abstract_Only
181+
or else Definition_Node.Kind in
182+
Libadalang.Common.Ada_Abstract_Subp_Decl_Range)
183+
then
184+
Decl_For_Find_Overrides := Definition_Node;
185+
end if;
186+
187+
-- Search for accept statements only if we are on an entry
188+
if Definition_Node.Kind in Libadalang.Common.Ada_Entry_Decl_Range then
189+
Entry_Decl_Node := Definition_Node.As_Entry_Decl;
190+
191+
elsif Definition_Node.Kind in
192+
Libadalang.Common.Ada_Single_Task_Type_Decl_Range |
193+
Libadalang.Common.Ada_Protected_Type_Decl_Range
194+
then
195+
-- These node types are not handled by Find_Next_Part
196+
-- (LAL design limitations)
197+
declare
198+
Other_Part_For_Decl : constant Libadalang.Analysis.Basic_Decl :=
199+
Laltools.Common.Find_Next_Part_For_Decl
200+
(Definition_Node, Trace);
201+
begin
202+
if not Other_Part_For_Decl.Is_Null then
203+
Other_Part := Other_Part_For_Decl.P_Defining_Name;
204+
end if;
205+
end;
206+
end if;
207+
208+
if Other_Part.Is_Null then
209+
-- No next part is found. Check first defining name
210+
Other_Part := Laltools.Common.Find_Canonical_Part
211+
(Definition, Trace);
212+
end if;
213+
214+
if Other_Part.Is_Null then
215+
-- We were on a defining name, but did not manage to find
216+
-- an answer using Find_Next_Part / Find_Canonical_Part.
217+
-- Use the manual fallback to attempt to find a good enough
218+
-- result.
219+
Manual_Fallback := Laltools.Common.Find_Other_Part_Fallback
220+
(Definition, Trace);
221+
222+
if not Manual_Fallback.Is_Null then
223+
-- We have found a result using the imprecise heuristics.
224+
-- We'll warn the user and send the result.
225+
Self.Parent.Context.Append_Location
226+
(Self.Response,
227+
Self.Filter,
228+
Manual_Fallback);
229+
end if;
230+
else
231+
Self.Parent.Context.Append_Location
232+
(Self.Response,
233+
Self.Filter,
234+
Other_Part);
235+
236+
end if;
237+
end if;
238+
239+
if not Decl_For_Find_Overrides.Is_Null then
240+
declare
241+
Overridings : constant Libadalang.Analysis.Basic_Decl_Array :=
242+
Context.Find_All_Overrides
243+
(Decl_For_Find_Overrides,
244+
Imprecise_Results => Ignore);
245+
246+
Bases : constant Libadalang.Analysis.Basic_Decl_Array :=
247+
Context.Find_All_Base_Declarations
248+
(Decl_For_Find_Overrides,
249+
Imprecise_Results => Ignore);
250+
begin
251+
for Subp of Bases loop
252+
Self.Parent.Context.Append_Location
253+
(Self.Response,
254+
Self.Filter,
255+
Subp.P_Defining_Name,
256+
Is_Parent);
257+
end loop;
258+
259+
for Subp of Overridings loop
260+
Self.Parent.Context.Append_Location
261+
(Self.Response,
262+
Self.Filter,
263+
Subp.P_Defining_Name,
264+
Is_Child);
265+
end loop;
266+
end;
267+
end if;
268+
269+
if not Entry_Decl_Node.Is_Null then
270+
for Accept_Node of Entry_Decl_Node.P_Accept_Stmts loop
271+
Self.Parent.Context.Append_Location
272+
(Self.Response,
273+
Self.Filter,
274+
Accept_Node.F_Body_Decl.F_Name);
275+
end loop;
276+
end if;
277+
end Execute_Request;
278+
279+
end LSP.Ada_Definition;

‎source/ada/lsp-ada_definition.ads

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
------------------------------------------------------------------------------
2+
-- Language Server Protocol --
3+
-- --
4+
-- Copyright (C) 2024, 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+
-- This package provides handler and job types for textDocument/definition
19+
-- requests.
20+
21+
with LSP.Ada_Job_Contexts;
22+
with LSP.Server_Jobs;
23+
with LSP.Server_Message_Handlers;
24+
with LSP.Server_Messages;
25+
26+
package LSP.Ada_Definition is
27+
28+
type Ada_Definition_Handler
29+
(Context : not null access LSP.Ada_Job_Contexts.Ada_Job_Context'Class) is
30+
limited new LSP.Server_Message_Handlers.Server_Message_Handler
31+
with null record;
32+
33+
overriding function Create_Job
34+
(Self : Ada_Definition_Handler;
35+
Message : LSP.Server_Messages.Server_Message_Access)
36+
return LSP.Server_Jobs.Server_Job_Access;
37+
38+
end LSP.Ada_Definition;

‎source/ada/lsp-ada_driver.adb

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,7 @@ with GNATCOLL.VFS; use GNATCOLL.VFS;
3838
with GNATCOLL.Utils;
3939

4040
with LSP.Ada_Commands;
41+
with LSP.Ada_Definition;
4142
with LSP.Ada_Did_Change_Configurations;
4243
with LSP.Ada_Did_Change_Document;
4344
with LSP.Ada_Hover;
@@ -76,6 +77,7 @@ with LSP.Predefined_Completion;
7677
with LSP.Secure_Message_Loggers;
7778
with LSP.Server_Notifications.DidChange;
7879
with LSP.Server_Notifications.DidChangeConfiguration;
80+
with LSP.Server_Requests.Definition;
7981
with LSP.Server_Requests.Hover;
8082
with LSP.Server_Requests.References;
8183
with LSP.Servers;
@@ -190,6 +192,9 @@ procedure LSP.Ada_Driver is
190192
Ada_Hover_Handler : aliased LSP.Ada_Hover.Ada_Hover_Handler
191193
(Ada_Handler'Unchecked_Access);
192194

195+
Ada_Definition_Handler : aliased LSP.Ada_Definition.Ada_Definition_Handler
196+
(Ada_Handler'Unchecked_Access);
197+
193198
GPR_Did_Change_Doc_Handler : aliased
194199
LSP.GPR_Did_Change_Document.GPR_Did_Change_Handler
195200
(GPR_Handler'Unchecked_Access);
@@ -402,6 +407,10 @@ begin
402407
(LSP.Server_Requests.Hover.Request'Tag,
403408
Ada_Hover_Handler'Unchecked_Access);
404409

410+
Server.Register_Handler
411+
(LSP.Server_Requests.Definition.Request'Tag,
412+
Ada_Definition_Handler'Unchecked_Access);
413+
405414
Server.Register_Handler
406415
(LSP.Server_Requests.References.Request'Tag,
407416
Ada_References_Handler'Unchecked_Access);

0 commit comments

Comments
 (0)