Skip to content

Commit 45be060

Browse files
reznikmmreznikmm
committed
Replace On_References_Request for Ada with a job
Refs #1141
1 parent 6ef4148 commit 45be060

File tree

7 files changed

+429
-208
lines changed

7 files changed

+429
-208
lines changed

‎source/ada/lsp-ada_contexts.ads‎

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -82,11 +82,6 @@ package LSP.Ada_Contexts is
8282
-- Release the memory associated to Self. You should not use the
8383
-- context after calling this.
8484

85-
-- function URI_To_File
86-
-- (Self : Context;
87-
-- URI : LSP.Types.LSP_URI)
88-
-- return Ada.Strings.UTF_Encoding.UTF_8_String;
89-
--
9085
function URI_To_File
9186
(Self : Context;
9287
URI : LSP.Structures.DocumentUri)

‎source/ada/lsp-ada_driver.adb‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -40,6 +40,7 @@ with GNATCOLL.Utils;
4040
with LSP.Ada_Commands;
4141
with LSP.Ada_Did_Change_Configurations;
4242
with LSP.Ada_Did_Change_Document;
43+
with LSP.Ada_References;
4344
with LSP.Ada_Handlers;
4445
with LSP.Ada_Handlers.Executables_Commands;
4546
with LSP.Ada_Handlers.Mains_Commands;
@@ -74,6 +75,7 @@ with LSP.Predefined_Completion;
7475
with LSP.Secure_Message_Loggers;
7576
with LSP.Server_Notifications.DidChange;
7677
with LSP.Server_Notifications.DidChangeConfiguration;
78+
with LSP.Server_Requests.References;
7779
with LSP.Servers;
7880
with LSP.Stdio_Streams;
7981

@@ -180,6 +182,9 @@ procedure LSP.Ada_Driver is
180182
LSP.Ada_Did_Change_Document.Ada_Did_Change_Handler
181183
(Ada_Handler'Unchecked_Access);
182184

185+
Ada_References_Handler : aliased LSP.Ada_References.Ada_References_Handler
186+
(Ada_Handler'Unchecked_Access);
187+
183188
GPR_Did_Change_Doc_Handler : aliased
184189
LSP.GPR_Did_Change_Document.GPR_Did_Change_Handler
185190
(GPR_Handler'Unchecked_Access);
@@ -388,6 +393,10 @@ begin
388393
(LSP.Server_Notifications.DidChange.Notification'Tag,
389394
Ada_Did_Change_Doc_Handler'Unchecked_Access);
390395

396+
Server.Register_Handler
397+
(LSP.Server_Requests.References.Request'Tag,
398+
Ada_References_Handler'Unchecked_Access);
399+
391400
Server.Run
392401
(Ada_Handler'Unchecked_Access,
393402
Tracer'Unchecked_Access,

‎source/ada/lsp-ada_handlers.adb‎

Lines changed: 16 additions & 197 deletions
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,6 @@
1515
-- of the license. --
1616
------------------------------------------------------------------------------
1717

18-
with Ada.Exceptions;
1918
with Ada.Strings.Unbounded;
2019
with Ada.Strings.UTF_Encoding;
2120
with Ada.Tags.Generic_Dispatching_Constructor;
@@ -32,7 +31,6 @@ with VSS.Strings.Templates;
3231
with VSS.String_Vectors;
3332
with VSS.JSON.Streams;
3433

35-
with Libadalang.Analysis;
3634
with Libadalang.Common;
3735

3836
with Laltools.Common;
@@ -60,7 +58,6 @@ with LSP.Ada_Completions.Parameters;
6058
with LSP.Ada_Completions.Pragmas;
6159
with LSP.Ada_Completions.Use_Clauses;
6260
with LSP.Ada_Completions;
63-
with LSP.Ada_Contexts;
6461
with LSP.Ada_Documentation;
6562
with LSP.Ada_Empty_Handlers;
6663
with LSP.Ada_Handlers.Call_Hierarchy;
@@ -87,14 +84,12 @@ with LSP.Ada_Handlers.Renaming;
8784
with LSP.Ada_Handlers.Symbols;
8885
with LSP.Ada_Commands;
8986
with LSP.Client_Side_File_Monitors;
90-
with LSP.Constants;
9187
with LSP.Diagnostic_Sources;
9288
with LSP.Enumerations;
9389
with LSP.Errors;
9490
with LSP.Formatters.Texts;
9591
with LSP.Generic_Cancel_Check;
9692
with LSP.GNATCOLL_Tracers.Handle;
97-
with LSP.Locations;
9893
with LSP.Predefined_Completion;
9994
with LSP.Search;
10095
with LSP.Servers;
@@ -154,20 +149,14 @@ package body LSP.Ada_Handlers is
154149
return Libadalang.Analysis.Ada_Node
155150
renames LSP.Ada_Handlers.Locations.Get_Node_At;
156151

157-
procedure Append_Location
152+
overriding procedure Append_Location
158153
(Self : in out Message_Handler;
159154
Result : in out LSP.Structures.Location_Vector;
160155
Filter : in out LSP.Locations.File_Span_Sets.Set;
161156
Node : Libadalang.Analysis.Ada_Node'Class;
162157
Kinds : AlsReferenceKind_Array := LSP.Constants.Empty)
163158
renames LSP.Ada_Handlers.Locations.Append_Location;
164159

165-
function Imprecise_Resolve_Name
166-
(Self : in out Message_Handler'Class;
167-
Context : LSP.Ada_Contexts.Context;
168-
Position : LSP.Structures.TextDocumentPositionParams'Class)
169-
return Libadalang.Analysis.Defining_Name;
170-
171160
function Project_Predefined_Units
172161
(Self : in out Message_Handler;
173162
Context : LSP.Ada_Contexts.Context)
@@ -348,8 +337,8 @@ package body LSP.Ada_Handlers is
348337
-- Imprecise_Resolve_Name --
349338
----------------------------
350339

351-
function Imprecise_Resolve_Name
352-
(Self : in out Message_Handler'Class;
340+
overriding function Imprecise_Resolve_Name
341+
(Self : in out Message_Handler;
353342
Context : LSP.Ada_Contexts.Context;
354343
Position : LSP.Structures.TextDocumentPositionParams'Class)
355344
return Libadalang.Analysis.Defining_Name
@@ -3706,189 +3695,6 @@ package body LSP.Ada_Handlers is
37063695
end if;
37073696
end On_RangeFormatting_Request;
37083697

3709-
---------------------------
3710-
-- On_References_Request --
3711-
---------------------------
3712-
3713-
overriding procedure On_References_Request
3714-
(Self : in out Message_Handler;
3715-
Id : LSP.Structures.Integer_Or_Virtual_String;
3716-
Value : LSP.Structures.ReferenceParams)
3717-
is
3718-
use all type LSP.Enumerations.AlsReferenceKind;
3719-
3720-
Response : LSP.Structures.Location_Vector_Or_Null;
3721-
Imprecise : Boolean := False;
3722-
Filter : LSP.Locations.File_Span_Sets.Set;
3723-
3724-
Additional_Kinds : AlsReferenceKind_Array :=
3725-
[others => False];
3726-
3727-
procedure Process_Context (C : LSP.Ada_Context_Sets.Context_Access);
3728-
-- Process the references found in one context and append
3729-
-- them to Response.results.
3730-
3731-
function Get_Reference_Kind
3732-
(Node : Libadalang.Analysis.Ada_Node'Class;
3733-
Is_Overriding_Decl : Boolean := False)
3734-
return AlsReferenceKind_Array;
3735-
-- Fetch reference kind for given node.
3736-
3737-
------------------------
3738-
-- Get_Reference_Kind --
3739-
------------------------
3740-
3741-
function Get_Reference_Kind
3742-
(Node : Libadalang.Analysis.Ada_Node'Class;
3743-
Is_Overriding_Decl : Boolean := False)
3744-
return AlsReferenceKind_Array
3745-
is
3746-
use type AlsReferenceKind_Array;
3747-
3748-
Id : constant Libadalang.Analysis.Name :=
3749-
Laltools.Common.Get_Node_As_Name (Node.As_Ada_Node);
3750-
3751-
Result : AlsReferenceKind_Array := [others => False];
3752-
begin
3753-
begin
3754-
Result (write) := Id.P_Is_Write_Reference;
3755-
exception
3756-
when E : Libadalang.Common.Property_Error =>
3757-
Self.Tracer.Trace_Exception (E);
3758-
end;
3759-
3760-
begin
3761-
Result (an_access) :=
3762-
Laltools.Common.Is_Access_Ref (Id.As_Ada_Node);
3763-
exception
3764-
when E : Libadalang.Common.Property_Error =>
3765-
Self.Tracer.Trace_Exception (E);
3766-
end;
3767-
3768-
begin
3769-
Result (call) := Id.P_Is_Static_Call;
3770-
exception
3771-
when E : Libadalang.Common.Property_Error =>
3772-
Self.Tracer.Trace_Exception (E);
3773-
end;
3774-
3775-
begin
3776-
Result (dispatching_call) :=
3777-
Id.P_Is_Dispatching_Call;
3778-
exception
3779-
when E : Libadalang.Common.Property_Error =>
3780-
Self.Tracer.Trace_Exception (E);
3781-
end;
3782-
3783-
begin
3784-
Result (child) :=
3785-
Laltools.Common.Is_Type_Derivation (Id.As_Ada_Node);
3786-
exception
3787-
when E : Libadalang.Common.Property_Error =>
3788-
Self.Tracer.Trace_Exception (E);
3789-
end;
3790-
3791-
Result (an_overriding) := Is_Overriding_Decl;
3792-
3793-
-- If the result has not any set flags at this point, flag it as a
3794-
-- simple reference.
3795-
if Result = [Result'Range => False] then
3796-
Result (reference) := True;
3797-
end if;
3798-
3799-
-- Apply additional kinds
3800-
Result := Result or Additional_Kinds;
3801-
3802-
return Result;
3803-
end Get_Reference_Kind;
3804-
3805-
---------------------
3806-
-- Process_Context --
3807-
---------------------
3808-
3809-
procedure Process_Context (C : LSP.Ada_Context_Sets.Context_Access) is
3810-
procedure Callback
3811-
(Node : Libadalang.Analysis.Base_Id;
3812-
Kind : Libadalang.Common.Ref_Result_Kind;
3813-
Cancel : in out Boolean);
3814-
3815-
procedure Callback
3816-
(Node : Libadalang.Analysis.Base_Id;
3817-
Kind : Libadalang.Common.Ref_Result_Kind;
3818-
Cancel : in out Boolean)
3819-
is
3820-
pragma Unreferenced (Kind);
3821-
begin
3822-
if not Laltools.Common.Is_End_Label (Node.As_Ada_Node) then
3823-
3824-
Self.Append_Location
3825-
(Response,
3826-
Filter,
3827-
Node,
3828-
Get_Reference_Kind (Node));
3829-
end if;
3830-
3831-
Cancel := Self.Is_Canceled.all;
3832-
end Callback;
3833-
3834-
Definition : Libadalang.Analysis.Defining_Name;
3835-
3836-
use Libadalang.Common;
3837-
begin
3838-
3839-
Definition := Self.Imprecise_Resolve_Name (C.all, Value);
3840-
3841-
if Definition.Is_Null or else Self.Is_Canceled.all then
3842-
return;
3843-
end if;
3844-
3845-
-- Set additional "reference" kind for enumeration literal
3846-
declare
3847-
Decl : constant Libadalang.Analysis.Basic_Decl :=
3848-
Libadalang.Analysis.P_Basic_Decl (Definition);
3849-
begin
3850-
if not Decl.Is_Null
3851-
and then Libadalang.Analysis.Kind (Decl) = Ada_Enum_Literal_Decl
3852-
then
3853-
Additional_Kinds (reference) := True;
3854-
end if;
3855-
3856-
-- Find all the references
3857-
C.Find_All_References (Definition, Callback'Access);
3858-
3859-
-- Find all the overriding declarations, if any
3860-
for Subp of C.Find_All_Overrides (Decl, Imprecise) loop
3861-
Self.Append_Location
3862-
(Response,
3863-
Filter,
3864-
Subp.P_Defining_Name,
3865-
Get_Reference_Kind
3866-
(Definition,
3867-
Is_Overriding_Decl => True));
3868-
end loop;
3869-
3870-
if Value.context.includeDeclaration then
3871-
Self.Append_Location
3872-
(Response,
3873-
Filter,
3874-
Definition,
3875-
Get_Reference_Kind (Definition));
3876-
end if;
3877-
end;
3878-
end Process_Context;
3879-
3880-
begin
3881-
for C of Self.Contexts_For_URI (Value.textDocument.uri) loop
3882-
Process_Context (C);
3883-
3884-
exit when Self.Is_Canceled.all;
3885-
end loop;
3886-
3887-
Locations.Sort (Response);
3888-
3889-
Self.Sender.On_References_Response (Id, Response);
3890-
end On_References_Request;
3891-
38923698
-----------------------
38933699
-- On_Rename_Request --
38943700
-----------------------
@@ -4733,4 +4539,17 @@ package body LSP.Ada_Handlers is
47334539
end return;
47344540
end To_Workspace_Edit;
47354541

4542+
---------------------
4543+
-- Trace_Exception --
4544+
---------------------
4545+
4546+
overriding procedure Trace_Exception
4547+
(Self : Message_Handler;
4548+
Error : Ada.Exceptions.Exception_Occurrence;
4549+
Message : VSS.Strings.Virtual_String :=
4550+
VSS.Strings.Empty_Virtual_String) is
4551+
begin
4552+
Self.Tracer.Trace_Exception (Error, Message);
4553+
end Trace_Exception;
4554+
47364555
end LSP.Ada_Handlers;

‎source/ada/lsp-ada_handlers.ads‎

Lines changed: 25 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -20,22 +20,28 @@
2020

2121
with Ada.Containers.Hashed_Maps;
2222
with Ada.Containers.Hashed_Sets;
23+
with Ada.Exceptions;
2324

2425
with GNATCOLL.VFS;
2526

2627
with GPR2.Project.Tree;
2728

29+
with Libadalang.Analysis;
30+
2831
with VSS.Strings.Conversions;
2932

3033
with LSP.Ada_Client_Capabilities;
3134
with LSP.Ada_Configurations;
3235
with LSP.Ada_Context_Sets;
36+
with LSP.Ada_Contexts;
3337
with LSP.Ada_Documents;
3438
with LSP.Ada_File_Sets;
3539
with LSP.Ada_Highlighters;
3640
with LSP.Ada_Job_Contexts;
3741
with LSP.Client_Message_Receivers;
42+
with LSP.Constants;
3843
with LSP.File_Monitors;
44+
with LSP.Locations;
3945
with LSP.Server_Message_Visitors;
4046
with LSP.Server_Notification_Receivers;
4147
with LSP.Server_Notifications;
@@ -294,11 +300,6 @@ private
294300
Id : LSP.Structures.Integer_Or_Virtual_String;
295301
Value : LSP.Structures.HoverParams);
296302

297-
overriding procedure On_References_Request
298-
(Self : in out Message_Handler;
299-
Id : LSP.Structures.Integer_Or_Virtual_String;
300-
Value : LSP.Structures.ReferenceParams);
301-
302303
overriding procedure On_Shutdown_Request
303304
(Self : in out Message_Handler;
304305
Id : LSP.Structures.Integer_Or_Virtual_String);
@@ -502,4 +503,23 @@ private
502503

503504
overriding procedure Reload_Project (Self : in out Message_Handler);
504505

506+
overriding function Imprecise_Resolve_Name
507+
(Self : in out Message_Handler;
508+
Context : LSP.Ada_Contexts.Context;
509+
Position : LSP.Structures.TextDocumentPositionParams'Class)
510+
return Libadalang.Analysis.Defining_Name;
511+
512+
overriding procedure Append_Location
513+
(Self : in out Message_Handler;
514+
Result : in out LSP.Structures.Location_Vector;
515+
Filter : in out LSP.Locations.File_Span_Sets.Set;
516+
Node : Libadalang.Analysis.Ada_Node'Class;
517+
Kinds : LSP.Structures.AlsReferenceKind_Set := LSP.Constants.Empty);
518+
519+
overriding procedure Trace_Exception
520+
(Self : Message_Handler;
521+
Error : Ada.Exceptions.Exception_Occurrence;
522+
Message : VSS.Strings.Virtual_String :=
523+
VSS.Strings.Empty_Virtual_String);
524+
505525
end LSP.Ada_Handlers;

0 commit comments

Comments
 (0)