-
Notifications
You must be signed in to change notification settings - Fork 60
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'topic/merge_to_edge' into 'edge'
Rewrite `textDocument/declaration` as a job See merge request eng/ide/ada_language_server!1530
- Loading branch information
Showing
6 changed files
with
309 additions
and
167 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,260 @@ | ||
| ------------------------------------------------------------------------------ | ||
| -- Language Server Protocol -- | ||
| -- -- | ||
| -- Copyright (C) 2024, AdaCore -- | ||
| -- -- | ||
| -- This is free software; you can redistribute it and/or modify it under -- | ||
| -- terms of the GNU General Public License as published by the Free Soft- -- | ||
| -- ware Foundation; either version 3, or (at your option) any later ver- -- | ||
| -- sion. This software is distributed in the hope that it will be useful, -- | ||
| -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- | ||
| -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- | ||
| -- License for more details. You should have received a copy of the GNU -- | ||
| -- General Public License distributed with this software; see file -- | ||
| -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- | ||
| -- of the license. -- | ||
| ------------------------------------------------------------------------------ | ||
|
|
||
| with GNATCOLL.Traces; | ||
| with GNATCOLL.VFS; | ||
|
|
||
| with Libadalang.Analysis; | ||
| with Libadalang.Common; | ||
|
|
||
| with Laltools.Common; | ||
|
|
||
| with LSP.Ada_Context_Sets; | ||
| with LSP.Ada_Handlers.Locations; | ||
| with LSP.Client_Message_Receivers; | ||
| with LSP.Enumerations; | ||
| with LSP.Locations; | ||
| with LSP.Server_Request_Jobs; | ||
| with LSP.Server_Requests.Declaration; | ||
| with LSP.Structures; | ||
|
|
||
| package body LSP.Ada_Declaration is | ||
|
|
||
| subtype AlsReferenceKind_Array is LSP.Structures.AlsReferenceKind_Set; | ||
|
|
||
| function Is_Parent return AlsReferenceKind_Array is | ||
| ([LSP.Enumerations.parent => True, others => False]); | ||
|
|
||
| function Is_Child return AlsReferenceKind_Array is | ||
| ([LSP.Enumerations.child => True, others => False]); | ||
|
|
||
| type Ada_Declaration_Job | ||
| (Parent : not null access constant Ada_Declaration_Handler) is limited | ||
| new LSP.Server_Request_Jobs.Server_Request_Job | ||
| (Priority => LSP.Server_Jobs.High) | ||
| with record | ||
| Response : LSP.Structures.Location_Vector; | ||
| Filter : LSP.Locations.File_Span_Sets.Set; | ||
| Contexts : LSP.Ada_Context_Sets.Context_Lists.List; | ||
| end record; | ||
|
|
||
| type Ada_Declaration_Job_Access is access all Ada_Declaration_Job; | ||
|
|
||
| overriding procedure Execute_Request | ||
| (Self : in out Ada_Declaration_Job; | ||
| Client : | ||
| in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class; | ||
| Status : out LSP.Server_Jobs.Execution_Status); | ||
|
|
||
| function "or" | ||
| (Left : | ||
| LSP.Structures.AlsDisplayMethodAncestryOnNavigationPolicy_Optional; | ||
| Right : LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy) | ||
| return LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy is | ||
| (if Left.Is_Set then Left.Value else Right); | ||
|
|
||
| ---------------- | ||
| -- Create_Job -- | ||
| ---------------- | ||
|
|
||
| overriding function Create_Job | ||
| (Self : Ada_Declaration_Handler; | ||
| Message : LSP.Server_Messages.Server_Message_Access) | ||
| return LSP.Server_Jobs.Server_Job_Access | ||
| is | ||
| Value : LSP.Server_Requests.Declaration.Request | ||
| renames LSP.Server_Requests.Declaration.Request | ||
| (Message.all); | ||
|
|
||
| File : constant GNATCOLL.VFS.Virtual_File := | ||
| Self.Context.To_File (Value.Params.textDocument.uri); | ||
|
|
||
| Result : constant Ada_Declaration_Job_Access := | ||
| new Ada_Declaration_Job' | ||
| (Parent => Self'Unchecked_Access, | ||
| Request => LSP.Server_Request_Jobs.Request_Access (Message), | ||
| others => <>); | ||
| begin | ||
| Result.Contexts := Self.Context.Contexts_For_File (File); | ||
|
|
||
| return LSP.Server_Jobs.Server_Job_Access (Result); | ||
| end Create_Job; | ||
|
|
||
| --------------------- | ||
| -- Execute_Request -- | ||
| --------------------- | ||
|
|
||
| overriding procedure Execute_Request | ||
| (Self : in out Ada_Declaration_Job; | ||
| Client : | ||
| in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class; | ||
| Status : out LSP.Server_Jobs.Execution_Status) | ||
| is | ||
| use type | ||
| LSP.Structures.AlsDisplayMethodAncestryOnNavigationPolicy_Optional; | ||
|
|
||
| use all type LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy; | ||
|
|
||
| Message : LSP.Server_Requests.Declaration.Request | ||
| renames LSP.Server_Requests.Declaration.Request (Self.Message.all); | ||
|
|
||
| Value : LSP.Structures.DeclarationParams renames Message.Params; | ||
|
|
||
| Context : LSP.Ada_Context_Sets.Context_Access; | ||
|
|
||
| Display_Method_Policy : constant | ||
| LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy := | ||
| Value.alsDisplayMethodAncestryOnNavigation | ||
| or | ||
| Self.Parent.Context.Get_Configuration.Display_Method_Ancestry_Policy; | ||
|
|
||
| Trace : constant GNATCOLL.Traces.Trace_Handle := | ||
| Self.Parent.Context.Get_Trace_Handle; | ||
|
|
||
| Name_Node : Libadalang.Analysis.Name; | ||
|
|
||
| Definition : Libadalang.Analysis.Defining_Name; | ||
| -- A defining name that corresponds to Name_Node | ||
| First_Part : Libadalang.Analysis.Defining_Name; | ||
| -- "Canonical part" of Definition | ||
| Prev_Part : Libadalang.Analysis.Defining_Name; | ||
| -- A previous name for Definition | ||
| Decl_For_Find_Overrides : Libadalang.Analysis.Basic_Decl := | ||
| Libadalang.Analysis.No_Basic_Decl; | ||
|
|
||
| On_Defining_Name : Boolean := False; | ||
| -- Set to True if we are on a denfining name node | ||
|
|
||
| Ignore : Boolean; | ||
| begin | ||
| if Self.Contexts.Is_Empty then | ||
| -- No more contexts to process, sort and return collected results | ||
| LSP.Ada_Handlers.Locations.Sort (Self.Response); | ||
|
|
||
| Client.On_Declaration_Response | ||
| (Message.Id, | ||
| (Kind => LSP.Structures.Variant_1, | ||
| Variant_1 => Self.Response)); | ||
|
|
||
| Status := LSP.Server_Jobs.Done; | ||
|
|
||
| return; | ||
| else | ||
| Status := LSP.Server_Jobs.Continue; | ||
| end if; | ||
|
|
||
| Context := Self.Contexts.First_Element; | ||
| Self.Contexts.Delete_First; | ||
|
|
||
| Name_Node := Laltools.Common.Get_Node_As_Name | ||
| (Self.Parent.Context.Get_Node_At (Context.all, Value)); | ||
|
|
||
| if Name_Node.Is_Null then | ||
| return; | ||
| end if; | ||
|
|
||
| -- Check if we are on some defining name | ||
| Definition := Laltools.Common.Get_Name_As_Defining (Name_Node); | ||
|
|
||
| if Definition.Is_Null then | ||
| -- If we aren't on a defining_name already then try to resolve | ||
| Definition := Laltools.Common.Resolve_Name (Name_Node, Trace, Ignore); | ||
| else | ||
| On_Defining_Name := True; | ||
| end if; | ||
|
|
||
| if Definition.Is_Null then | ||
| return; -- Name resolution fails, nothing to do. | ||
| end if; | ||
|
|
||
| -- Display the method ancestry in three cases: | ||
| -- | ||
| -- . When the preference is set to Always | ||
| -- | ||
| -- . When we are on a usage node (e.g: subprogram call) and if the | ||
| -- preference is set to Usage_And_Abstract_Only | ||
| -- | ||
| -- . When we are on a defining name node and if the preference is | ||
| -- set to Definition_Only | ||
|
|
||
| if Display_Method_Policy = Always | ||
| or else (Display_Method_Policy = Usage_And_Abstract_Only | ||
| and then not On_Defining_Name) | ||
| or else (Display_Method_Policy = Definition_Only | ||
| and then On_Defining_Name) | ||
| then | ||
| First_Part := Laltools.Common.Find_Canonical_Part (Definition, Trace); | ||
|
|
||
| Decl_For_Find_Overrides := | ||
| (if First_Part.Is_Null then Definition.P_Basic_Decl | ||
| else First_Part.P_Basic_Decl); | ||
| end if; | ||
|
|
||
| begin | ||
| Prev_Part := Definition.P_Previous_Part; | ||
| exception | ||
| when E : Libadalang.Common.Property_Error => | ||
| Self.Parent.Context.Trace_Exception (E); | ||
| Prev_Part := Libadalang.Analysis.No_Defining_Name; | ||
| end; | ||
|
|
||
| if not Prev_Part.Is_Null then | ||
| -- We have found previous part, return it. | ||
| Self.Parent.Context.Append_Location | ||
| (Self.Response, | ||
| Self.Filter, | ||
| Prev_Part); | ||
| elsif not Definition.Is_Null then | ||
| -- No previous part, return definition itself. | ||
| Self.Parent.Context.Append_Location | ||
| (Self.Response, | ||
| Self.Filter, | ||
| Definition); | ||
| end if; | ||
|
|
||
| if not Decl_For_Find_Overrides.Is_Null then | ||
| declare | ||
| Overridings : constant Libadalang.Analysis.Basic_Decl_Array := | ||
| Context.Find_All_Overrides | ||
| (Decl_For_Find_Overrides, | ||
| Imprecise_Results => Ignore); | ||
|
|
||
| Bases : constant Libadalang.Analysis.Basic_Decl_Array := | ||
| Context.Find_All_Base_Declarations | ||
| (Decl_For_Find_Overrides, | ||
| Imprecise_Results => Ignore); | ||
| begin | ||
| for Subp of Bases loop | ||
| Self.Parent.Context.Append_Location | ||
| (Self.Response, | ||
| Self.Filter, | ||
| Subp.P_Defining_Name, | ||
| Is_Parent); | ||
| end loop; | ||
|
|
||
| for Subp of Overridings loop | ||
| Self.Parent.Context.Append_Location | ||
| (Self.Response, | ||
| Self.Filter, | ||
| Subp.P_Defining_Name, | ||
| Is_Child); | ||
| end loop; | ||
| end; | ||
| end if; | ||
| end Execute_Request; | ||
|
|
||
| end LSP.Ada_Declaration; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,38 @@ | ||
| ------------------------------------------------------------------------------ | ||
| -- Language Server Protocol -- | ||
| -- -- | ||
| -- Copyright (C) 2024, AdaCore -- | ||
| -- -- | ||
| -- This is free software; you can redistribute it and/or modify it under -- | ||
| -- terms of the GNU General Public License as published by the Free Soft- -- | ||
| -- ware Foundation; either version 3, or (at your option) any later ver- -- | ||
| -- sion. This software is distributed in the hope that it will be useful, -- | ||
| -- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- | ||
| -- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public -- | ||
| -- License for more details. You should have received a copy of the GNU -- | ||
| -- General Public License distributed with this software; see file -- | ||
| -- COPYING3. If not, go to http://www.gnu.org/licenses for a complete copy -- | ||
| -- of the license. -- | ||
| ------------------------------------------------------------------------------ | ||
|
|
||
| -- This package provides handler and job types for textDocument/declaration | ||
| -- requests. | ||
|
|
||
| with LSP.Ada_Job_Contexts; | ||
| with LSP.Server_Jobs; | ||
| with LSP.Server_Message_Handlers; | ||
| with LSP.Server_Messages; | ||
|
|
||
| package LSP.Ada_Declaration is | ||
|
|
||
| type Ada_Declaration_Handler | ||
| (Context : not null access LSP.Ada_Job_Contexts.Ada_Job_Context'Class) is | ||
| limited new LSP.Server_Message_Handlers.Server_Message_Handler | ||
| with null record; | ||
|
|
||
| overriding function Create_Job | ||
| (Self : Ada_Declaration_Handler; | ||
| Message : LSP.Server_Messages.Server_Message_Access) | ||
| return LSP.Server_Jobs.Server_Job_Access; | ||
|
|
||
| end LSP.Ada_Declaration; |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.