From cab4204c88832fb6522a15a5c5763a8818cb8c8d Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Wed, 3 Apr 2024 13:06:26 +0300 Subject: [PATCH 1/2] Fix checking `e3` Python module --- Makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Makefile b/Makefile index fe85966ac..638ef3b25 100644 --- a/Makefile +++ b/Makefile @@ -160,7 +160,7 @@ vscode-package: check: all set -e; \ export PYTHON=$(PYTHON); \ - if [ `$(PYTHON) -c "import sys;print('e3' in sys.modules)"` = "True" ]; then\ + if [ `$(PYTHON) -c "import e3,sys;print('e3' in sys.modules)"` = "True" ]; then\ (cd testsuite ; sh run.sh $(test)) ; \ else \ for a in testsuite/*_lsp/*/*.json; do \ From 5abf35a79c04ee2f718216ef9c5ccfadbf36e51f Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Wed, 3 Apr 2024 13:07:04 +0300 Subject: [PATCH 2/2] Rewrite `textDocument/declaration` as a job Refs #1141 --- source/ada/lsp-ada_declaration.adb | 260 +++++++++++++++++++++++++++++ source/ada/lsp-ada_declaration.ads | 38 +++++ source/ada/lsp-ada_driver.adb | 10 ++ source/ada/lsp-ada_handlers.adb | 155 ----------------- source/ada/lsp-ada_handlers.ads | 5 - 5 files changed, 308 insertions(+), 160 deletions(-) create mode 100644 source/ada/lsp-ada_declaration.adb create mode 100644 source/ada/lsp-ada_declaration.ads diff --git a/source/ada/lsp-ada_declaration.adb b/source/ada/lsp-ada_declaration.adb new file mode 100644 index 000000000..fe8e54ed7 --- /dev/null +++ b/source/ada/lsp-ada_declaration.adb @@ -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; diff --git a/source/ada/lsp-ada_declaration.ads b/source/ada/lsp-ada_declaration.ads new file mode 100644 index 000000000..ce5fa71f3 --- /dev/null +++ b/source/ada/lsp-ada_declaration.ads @@ -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; diff --git a/source/ada/lsp-ada_driver.adb b/source/ada/lsp-ada_driver.adb index 31ccdff3b..2a68bde92 100644 --- a/source/ada/lsp-ada_driver.adb +++ b/source/ada/lsp-ada_driver.adb @@ -39,6 +39,7 @@ with GNATCOLL.Utils; with LSP.Ada_Commands; with LSP.Ada_Definition; +with LSP.Ada_Declaration; with LSP.Ada_Did_Change_Configurations; with LSP.Ada_Did_Change_Document; with LSP.Ada_Hover; @@ -78,6 +79,7 @@ with LSP.Secure_Message_Loggers; with LSP.Server_Notifications.DidChange; with LSP.Server_Notifications.DidChangeConfiguration; with LSP.Server_Requests.Definition; +with LSP.Server_Requests.Declaration; with LSP.Server_Requests.Hover; with LSP.Server_Requests.References; with LSP.Servers; @@ -195,6 +197,10 @@ procedure LSP.Ada_Driver is Ada_Definition_Handler : aliased LSP.Ada_Definition.Ada_Definition_Handler (Ada_Handler'Unchecked_Access); + Ada_Declaration_Handler : aliased + LSP.Ada_Declaration.Ada_Declaration_Handler + (Ada_Handler'Unchecked_Access); + GPR_Did_Change_Doc_Handler : aliased LSP.GPR_Did_Change_Document.GPR_Did_Change_Handler (GPR_Handler'Unchecked_Access); @@ -411,6 +417,10 @@ begin (LSP.Server_Requests.Definition.Request'Tag, Ada_Definition_Handler'Unchecked_Access); + Server.Register_Handler + (LSP.Server_Requests.Declaration.Request'Tag, + Ada_Declaration_Handler'Unchecked_Access); + Server.Register_Handler (LSP.Server_Requests.References.Request'Tag, Ada_References_Handler'Unchecked_Access); diff --git a/source/ada/lsp-ada_handlers.adb b/source/ada/lsp-ada_handlers.adb index e40c76312..7f4cd9a66 100644 --- a/source/ada/lsp-ada_handlers.adb +++ b/source/ada/lsp-ada_handlers.adb @@ -1676,161 +1676,6 @@ package body LSP.Ada_Handlers is Self.Sender.On_Completion_Resolve_Response (Id, Response); end On_Completion_Resolve_Request; - ---------------------------- - -- On_Declaration_Request -- - ---------------------------- - - overriding procedure On_Declaration_Request - (Self : in out Message_Handler; - Id : LSP.Structures.Integer_Or_Virtual_String; - Value : LSP.Structures.DeclarationParams) - is - use Libadalang.Analysis; - use all type LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy; - - procedure Resolve_In_Context (C : LSP.Ada_Context_Sets.Context_Access); - -- Utility function, appends to Vector all results of the - -- declaration requests found in context C. - - Response : LSP.Structures.Declaration_Result (LSP.Structures.Variant_1); - Vector : LSP.Structures.Location_Vector renames Response.Variant_1; - Filter : LSP.Locations.File_Span_Sets.Set; - - Display_Method_Policy : constant - LSP.Enumerations.AlsDisplayMethodAncestryOnNavigationPolicy := - (if Value.alsDisplayMethodAncestryOnNavigation.Is_Set - then Value.alsDisplayMethodAncestryOnNavigation.Value - else Self.Configuration.Display_Method_Ancestry_Policy); - - ------------------------ - -- Resolve_In_Context -- - ------------------------ - - procedure Resolve_In_Context (C : LSP.Ada_Context_Sets.Context_Access) is - Trace : constant GNATCOLL.Traces.Trace_Handle := - LSP.GNATCOLL_Tracers.Handle (Self.Tracer.all); - - Name_Node : constant Name := - Laltools.Common.Get_Node_As_Name (Self.Get_Node_At (C.all, Value)); - - 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 - - Is_Imprecise : Boolean; - begin - 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, Is_Imprecise); - 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); - - if First_Part.Is_Null then - Decl_For_Find_Overrides := Definition.P_Basic_Decl; - else - Decl_For_Find_Overrides := First_Part.P_Basic_Decl; - end if; - end if; - - begin - Prev_Part := Definition.P_Previous_Part; - exception - when E : Libadalang.Common.Property_Error => - Self.Tracer.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.Append_Location (Vector, Filter, Prev_Part); - elsif not Definition.Is_Null then - -- No previous part, return definition itself. - Self.Append_Location (Vector, Filter, Definition); - end if; - - if not Decl_For_Find_Overrides.Is_Null then - declare - Overridings : constant Libadalang.Analysis.Basic_Decl_Array := - C.Find_All_Overrides - (Decl_For_Find_Overrides, - Imprecise_Results => Is_Imprecise); - - Bases : constant Libadalang.Analysis.Basic_Decl_Array := - C.Find_All_Base_Declarations - (Decl_For_Find_Overrides, - Imprecise_Results => Is_Imprecise); - begin - for Subp of Bases loop - Self.Append_Location - (Vector, Filter, Subp.P_Defining_Name, Is_Parent); - end loop; - - for Subp of Overridings loop - Self.Append_Location - (Vector, Filter, Subp.P_Defining_Name, Is_Child); - end loop; - end; - end if; - end Resolve_In_Context; - - begin - -- Override the displayMethodAncestryOnNavigation global configuration - -- flag if there is on embedded in the request. - -- if Value.alsDisplayMethodAncestryOnNavigation.Is_Set then - -- Display_Method_Ancestry_Policy := - -- Value.alsDisplayMethodAncestryOnNavigation.Value; - -- end if; - - for C of Self.Contexts_For_URI (Value.textDocument.uri) loop - Resolve_In_Context (C); - - exit when Self.Is_Canceled.all; - end loop; - - Locations.Sort (Vector); - - Self.Sender.On_Declaration_Response (Id, Response); - end On_Declaration_Request; - ------------------------------------------- -- On_DidChangeWatchedFiles_Notification -- ------------------------------------------- diff --git a/source/ada/lsp-ada_handlers.ads b/source/ada/lsp-ada_handlers.ads index 2d706d7fb..4cb441c0c 100644 --- a/source/ada/lsp-ada_handlers.ads +++ b/source/ada/lsp-ada_handlers.ads @@ -294,11 +294,6 @@ private Id : LSP.Structures.Integer_Or_Virtual_String; Value : LSP.Structures.AlsCheckSyntaxParams); - overriding procedure On_Declaration_Request - (Self : in out Message_Handler; - Id : LSP.Structures.Integer_Or_Virtual_String; - Value : LSP.Structures.DeclarationParams); - overriding procedure On_DocumentHighlight_Request (Self : in out Message_Handler; Id : LSP.Structures.Integer_Or_Virtual_String;