From 7c93ff364fe0a27567ac6f4f78b76f5093aac50a Mon Sep 17 00:00:00 2001 From: Anthony Leonardo Gracio Date: Mon, 1 Jul 2024 10:38:16 +0000 Subject: [PATCH 1/5] Filter invisible completion items by unit prefix For eng/ide/ada_language_server#1253 --- source/ada/lsp-ada_contexts.adb | 10 +- source/ada/lsp-ada_contexts.ads | 6 +- source/ada/lsp-ada_file_sets.adb | 34 ++- source/ada/lsp-ada_file_sets.ads | 4 +- source/ada/lsp-ada_handlers-invisibles.adb | 46 ++-- .../bar.ads | 9 + .../default.gpr | 2 + .../foo.ads | 7 + .../main.adb | 5 + .../test.json | 222 ++++++++++++++++++ .../test.yaml | 1 + 11 files changed, 322 insertions(+), 24 deletions(-) create mode 100644 testsuite/ada_lsp/completion.invisible.unit_filtering/bar.ads create mode 100644 testsuite/ada_lsp/completion.invisible.unit_filtering/default.gpr create mode 100644 testsuite/ada_lsp/completion.invisible.unit_filtering/foo.ads create mode 100644 testsuite/ada_lsp/completion.invisible.unit_filtering/main.adb create mode 100644 testsuite/ada_lsp/completion.invisible.unit_filtering/test.json create mode 100644 testsuite/ada_lsp/completion.invisible.unit_filtering/test.yaml diff --git a/source/ada/lsp-ada_contexts.adb b/source/ada/lsp-ada_contexts.adb index 3432915e6..4a8a5bb62 100644 --- a/source/ada/lsp-ada_contexts.adb +++ b/source/ada/lsp-ada_contexts.adb @@ -482,7 +482,9 @@ package body LSP.Ada_Contexts is Callback : not null access procedure (File : GNATCOLL.VFS.Virtual_File; Name : Libadalang.Analysis.Defining_Name; - Stop : in out Boolean)) + Stop : in out Boolean); + Unit_Prefix : VSS.Strings.Virtual_String := + VSS.Strings.Empty_Virtual_String) is function Get_Defining_Name (File : GNATCOLL.VFS.Virtual_File; @@ -509,7 +511,11 @@ package body LSP.Ada_Contexts is begin Self.Source_Files.Get_Any_Symbol - (Pattern, Only_Public, Get_Defining_Name'Access, Callback); + (Pattern => Pattern, + Only_Public => Only_Public, + Get_Defining_Name => Get_Defining_Name'Access, + Callback => Callback, + Unit_Prefix => Unit_Prefix); end Get_Any_Symbol; ----------------- diff --git a/source/ada/lsp-ada_contexts.ads b/source/ada/lsp-ada_contexts.ads index 4a664cee9..6ddf1cbda 100644 --- a/source/ada/lsp-ada_contexts.ads +++ b/source/ada/lsp-ada_contexts.ads @@ -245,11 +245,15 @@ package LSP.Ada_Contexts is Callback : not null access procedure (File : GNATCOLL.VFS.Virtual_File; Name : Libadalang.Analysis.Defining_Name; - Stop : in out Boolean)); + Stop : in out Boolean); + Unit_Prefix : VSS.Strings.Virtual_String := + VSS.Strings.Empty_Virtual_String); -- Find symbols starting with given Prefix in all files of the context and -- call Callback for each. Name could contain a stale reference if the File -- was updated since last indexing operation. If Only_Public is True it -- will skip any "private" symbols (like symbols in private part or body). + -- Unit_Prefix is used for additional filtering: when specified, only the + -- symbols declared in this non-visible unit will be returned. function Charset (Self : Context) return String; -- Return the charset for this context diff --git a/source/ada/lsp-ada_file_sets.adb b/source/ada/lsp-ada_file_sets.adb index 99e679266..84a5a8b4a 100644 --- a/source/ada/lsp-ada_file_sets.adb +++ b/source/ada/lsp-ada_file_sets.adb @@ -16,12 +16,15 @@ ------------------------------------------------------------------------------ with Langkit_Support.Symbols; use Langkit_Support.Symbols; +with Langkit_Support.Text; with Libadalang.Common; use Libadalang.Common; with Libadalang.Iterators; with Libadalang.Sources; with LSP.Predicates; +with VSS.Strings.Conversions; + package body LSP.Ada_File_Sets is procedure Flush_File_Index @@ -91,7 +94,9 @@ package body LSP.Ada_File_Sets is Callback : not null access procedure (File : GNATCOLL.VFS.Virtual_File; Defining_Name : Libadalang.Analysis.Defining_Name; - Stop : in out Boolean)) + Stop : in out Boolean); + Unit_Prefix : VSS.Strings.Virtual_String := + VSS.Strings.Empty_Virtual_String) is use all type LSP.Search.Search_Kind; @@ -105,6 +110,29 @@ package body LSP.Ada_File_Sets is and then Pattern.Get_Whole_Word) or else Pattern.Get_Kind = Start_Word_Text); + function Matches_Unit_Prefix + (Name : Libadalang.Analysis.Defining_Name'Class) return Boolean; + -- Return true if the given defining name's unit matches the unit prefix + -- given in parameter. + + ------------------------- + -- Matches_Unit_Prefix -- + ------------------------- + + function Matches_Unit_Prefix + (Name : Libadalang.Analysis.Defining_Name'Class) return Boolean + is + Unit_Root_Decl : constant Libadalang.Analysis.Basic_Decl := + Name.P_Enclosing_Compilation_Unit.P_Decl; + Unit_Name : constant VSS.Strings.Virtual_String := + VSS.Strings.Conversions.To_Virtual_String + (Langkit_Support.Text.To_UTF8 + (Unit_Root_Decl.P_Fully_Qualified_Name)); + begin + return Unit_Prefix.Is_Empty + or else Unit_Name.Starts_With (Unit_Prefix); + end Matches_Unit_Prefix; + begin if Use_Celling then Cursor := Self.All_Symbols.Ceiling (Pattern.Get_Canonical_Pattern); @@ -139,7 +167,9 @@ package body LSP.Ada_File_Sets is for Item of Self.All_Symbols (Cursor) loop if not Only_Public or else Item.Is_Public then Defining_Name := Get_Defining_Name (Item.File, Item.Loc); - if not Defining_Name.Is_Null then + if not Defining_Name.Is_Null + and then Matches_Unit_Prefix (Defining_Name) + then Callback (Item.File, Defining_Name, Stop); end if; end if; diff --git a/source/ada/lsp-ada_file_sets.ads b/source/ada/lsp-ada_file_sets.ads index 28812bcec..f82810b5a 100644 --- a/source/ada/lsp-ada_file_sets.ads +++ b/source/ada/lsp-ada_file_sets.ads @@ -85,7 +85,9 @@ package LSP.Ada_File_Sets is Callback : not null access procedure (File : GNATCOLL.VFS.Virtual_File; Defining_Name : Libadalang.Analysis.Defining_Name; - Stop : in out Boolean)); + Stop : in out Boolean); + Unit_Prefix : VSS.Strings.Virtual_String := + VSS.Strings.Empty_Virtual_String); -- Find symbols starting with given Prefix in all files of the set and -- call Callback for each. Get_Defining_Name callback is used for getting -- the Defining_Name at the given location Loc in a unit. diff --git a/source/ada/lsp-ada_handlers-invisibles.adb b/source/ada/lsp-ada_handlers-invisibles.adb index a102fb6e2..13c76cf76 100644 --- a/source/ada/lsp-ada_handlers-invisibles.adb +++ b/source/ada/lsp-ada_handlers-invisibles.adb @@ -15,8 +15,11 @@ -- of the license. -- ------------------------------------------------------------------------------ +with GNATCOLL; +with GNATCOLL.Utils; with GNATCOLL.VFS; +with Langkit_Support.Text; with VSS.Strings; with LSP.Enumerations; @@ -39,8 +42,6 @@ package body LSP.Ada_Handlers.Invisibles is Result : in out LSP.Structures.CompletionList) is pragma Unreferenced (Result); - use all type Libadalang.Common.Token_Kind; - use all type Libadalang.Common.Token_Reference; use type Ada.Containers.Count_Type; procedure On_Inaccessible_Name @@ -79,22 +80,17 @@ package body LSP.Ada_Handlers.Invisibles is end if; end On_Inaccessible_Name; - Previous_Tok : constant Libadalang.Common.Token_Reference := - Libadalang.Common.Previous (Token, Exclude_Trivia => True); - Dot_Token : constant Libadalang.Common.Token_Data_Type := - Libadalang.Common.Data - (if Libadalang.Common.Is_Trivia (Token) - and then Previous_Tok /= Libadalang.Common.No_Token - then Previous_Tok - else Token); - function Dummy_Canceled return Boolean is (False); + Unit_Prefix : VSS.Strings.Virtual_String; + -- The unit prefix specified before the point of completion, if any + -- (e.g: "Ada.Text_IO" when completing "Ada.Text_IO."). + -- Used to filter invisible completion items: if there is a unit prefix, + -- we want to show only the public symbols declared in this + -- non-visible unit. + begin - if Libadalang.Common.Kind (Dot_Token) = Ada_Dot then - -- Don't provide completion after a dot - return; - elsif Filter.Is_Numeric_Literal + if Filter.Is_Numeric_Literal or else Filter.Is_Attribute_Ref or else Filter.Is_Aspect or else Filter.Is_End_Label @@ -111,8 +107,7 @@ package body LSP.Ada_Handlers.Invisibles is if Node.Is_Null or else (not Node.Parent.Is_Null and then Node.Parent.Kind in Libadalang.Common.Ada_Defining_Name_Range - | Libadalang.Common.Ada_Dotted_Name_Range - | Libadalang.Common.Ada_Ada_Node_List_Range) + | Libadalang.Common.Ada_Ada_Node_List_Range) then return; end if; @@ -123,6 +118,20 @@ package body LSP.Ada_Handlers.Invisibles is return; end if; + -- We are completing a dotted-name: check if we have a unit prefix + if Node.Kind in Libadalang.Common.Ada_Dotted_Name_Range then + declare + Prefix : constant String := + Langkit_Support.Text.To_UTF8 (Node.Text); + Dot_Idx : Integer := -1; + begin + Dot_Idx := GNATCOLL.Utils.Find_Char (Prefix, '.'); + Unit_Prefix := + VSS.Strings.Conversions.To_Virtual_String + (Prefix (Prefix'First .. Dot_Idx - 1)); + end; + end if; + declare Word : constant VSS.Strings.Virtual_String := VSS.Strings.To_Virtual_String @@ -146,7 +155,8 @@ package body LSP.Ada_Handlers.Invisibles is Self.Context.Get_Any_Symbol (Pattern => Pattern, Only_Public => True, - Callback => On_Inaccessible_Name'Access); + Callback => On_Inaccessible_Name'Access, + Unit_Prefix => Unit_Prefix); for Doc of Self.Handler.Open_Documents loop Doc.Get_Any_Symbol diff --git a/testsuite/ada_lsp/completion.invisible.unit_filtering/bar.ads b/testsuite/ada_lsp/completion.invisible.unit_filtering/bar.ads new file mode 100644 index 000000000..682c15d04 --- /dev/null +++ b/testsuite/ada_lsp/completion.invisible.unit_filtering/bar.ads @@ -0,0 +1,9 @@ +package Bar is + + type My_Int is tagged record + A : Integer; + end record; + + procedure Do_Nothing; + +end Bar; diff --git a/testsuite/ada_lsp/completion.invisible.unit_filtering/default.gpr b/testsuite/ada_lsp/completion.invisible.unit_filtering/default.gpr new file mode 100644 index 000000000..e8f5929e9 --- /dev/null +++ b/testsuite/ada_lsp/completion.invisible.unit_filtering/default.gpr @@ -0,0 +1,2 @@ +project Default is +end Default; diff --git a/testsuite/ada_lsp/completion.invisible.unit_filtering/foo.ads b/testsuite/ada_lsp/completion.invisible.unit_filtering/foo.ads new file mode 100644 index 000000000..41b174a9f --- /dev/null +++ b/testsuite/ada_lsp/completion.invisible.unit_filtering/foo.ads @@ -0,0 +1,7 @@ +package Foo is + + procedure Do_Nothing is null; + + type Foo_Type is tagged null record; + +end Foo; diff --git a/testsuite/ada_lsp/completion.invisible.unit_filtering/main.adb b/testsuite/ada_lsp/completion.invisible.unit_filtering/main.adb new file mode 100644 index 000000000..5e67425d4 --- /dev/null +++ b/testsuite/ada_lsp/completion.invisible.unit_filtering/main.adb @@ -0,0 +1,5 @@ + +procedure Main is +begin + Foo +end Main; diff --git a/testsuite/ada_lsp/completion.invisible.unit_filtering/test.json b/testsuite/ada_lsp/completion.invisible.unit_filtering/test.json new file mode 100644 index 000000000..6e3293a8a --- /dev/null +++ b/testsuite/ada_lsp/completion.invisible.unit_filtering/test.json @@ -0,0 +1,222 @@ +[ + { + "comment": [ + "This test check that we filter invisible completion items", + " on units that have been specified before a '.' in any (i.e: if we type 'Ada.Text_IO.'", + " we list only the symbols defined in 'Ada.Text_IO')" + ] + }, + { + "start": { + "cmd": ["${ALS}"] + } + }, + { + "send": { + "request": { + "jsonrpc": "2.0", + "id": 1, + "method": "initialize", + "params": { + "processId": 199714, + "rootUri": "$URI{.}", + "capabilities": { + "workspace": { + "applyEdit": true + }, + "textDocument": { + "completion": { + "completionItem": { + "snippetSupport": true, + "documentationFormat": ["markdown", "plaintext"] + } + } + }, + "window": { + "workDoneProgress": true + } + } + } + }, + "wait": [ + { + "jsonrpc": "2.0", + "id": 1, + "result": { + "capabilities": { + "textDocumentSync": 2, + "completionProvider": { + "triggerCharacters": [".", ",", "'", "("], + "resolveProvider": true + } + } + } + } + ] + } + }, + { + "send": { + "request": { + "jsonrpc": "2.0", + "method": "initialized" + }, + "wait": [] + } + }, + { + "send": { + "request": { + "jsonrpc": "2.0", + "method": "workspace/didChangeConfiguration", + "params": { + "settings": { + "ada": { + "projectFile": "default.gpr" + } + } + } + }, + "wait": [ + { + "jsonrpc": "2.0", + "method": "$/progress", + "params": { + "token": "", + "value": { + "kind": "end" + } + } + } + ] + } + }, + { + "send": { + "request": { + "jsonrpc": "2.0", + "method": "textDocument/didOpen", + "params": { + "textDocument": { + "text": "\nwith Ada.Text_IO;\n\nprocedure Main is\n\nbegin\n\n Foo.\nend Main;\n", + "version": 1, + "uri": "$URI{main.adb}", + "languageId": "ada" + } + } + }, + "wait": [] + } + }, + { + "send": { + "request": { + "jsonrpc": "2.0", + "id": 7, + "method": "textDocument/completion", + "params": { + "textDocument": { + "uri": "$URI{main.adb}" + }, + "position": { + "line": 7, + "character": 10 + }, + "context": { + "triggerKind": 1 + } + } + }, + "sortReply": { "result": { "items": ["label", "documentation"] } }, + "wait": [ + { + "jsonrpc": "2.0", + "id": 7, + "result": { + "isIncomplete": false, + "items": [ + { + "command": { + "arguments": [ + { + "context": "Default", + "import": "Foo", + "qualifier": "", + "where": { + "position": { + "character": 8, + "line": 7 + }, + "textDocument": { + "uri": "$URI{main.adb}" + } + } + } + ], + "command": "als-auto-import", + "title": "" + }, + "detail": "procedure Do_Nothing", + "documentation": "at foo.ads (3:4)", + "filterText": "Do_Nothing", + "insertText": "Do_Nothing", + "kind": 3, + "label": "Do_Nothing (invisible)", + "sortText": "~25&00001Do_Nothing" + }, + { + "command": { + "arguments": [ + { + "context": "Default", + "import": "Foo", + "qualifier": "", + "where": { + "position": { + "character": 8, + "line": 7 + }, + "textDocument": { + "uri": "$URI{main.adb}" + } + } + } + ], + "command": "als-auto-import", + "title": "" + }, + "detail": "type Foo_Type is tagged null record;", + "documentation": "at foo.ads (5:4)", + "filterText": "Foo_Type", + "insertText": "Foo_Type", + "kind": 7, + "label": "Foo_Type (invisible)", + "sortText": "~100&00002Foo_Type" + } + ] + } + } + ] + } + }, + { + "send": { + "request": { + "jsonrpc": "2.0", + "id": 44, + "method": "shutdown" + }, + "wait": [ + { + "id": 44, + "result": null + } + ] + } + }, + { + "stop": { + "exit_code": 0 + } + } +] diff --git a/testsuite/ada_lsp/completion.invisible.unit_filtering/test.yaml b/testsuite/ada_lsp/completion.invisible.unit_filtering/test.yaml new file mode 100644 index 000000000..c4de64645 --- /dev/null +++ b/testsuite/ada_lsp/completion.invisible.unit_filtering/test.yaml @@ -0,0 +1 @@ +title: 'completion.invisible.unit_filtering' From 1adf4cf352f02e7d42ce3088c6b55d092846e7d3 Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Mon, 24 Jun 2024 15:06:46 +0300 Subject: [PATCH 2/5] Rename Sequential_Message_Handler to Default_Message_Handler Refs #1141 --- ...s.adb => lsp-default_message_handlers.adb} | 29 ++++++++++--------- ...s.ads => lsp-default_message_handlers.ads} | 28 +++++++++++------- source/server/lsp-servers.ads | 4 +-- 3 files changed, 35 insertions(+), 26 deletions(-) rename source/server/{lsp-sequential_message_handlers.adb => lsp-default_message_handlers.adb} (84%) rename source/server/{lsp-sequential_message_handlers.ads => lsp-default_message_handlers.ads} (69%) diff --git a/source/server/lsp-sequential_message_handlers.adb b/source/server/lsp-default_message_handlers.adb similarity index 84% rename from source/server/lsp-sequential_message_handlers.adb rename to source/server/lsp-default_message_handlers.adb index 994b7b8f1..acba35ef7 100644 --- a/source/server/lsp-sequential_message_handlers.adb +++ b/source/server/lsp-default_message_handlers.adb @@ -17,20 +17,20 @@ with LSP.Client_Message_Receivers; -package body LSP.Sequential_Message_Handlers is +package body LSP.Default_Message_Handlers is type Sequential_Job is new LSP.Server_Jobs.Server_Job with record - Handler : Server_Message_Visitor_Access; - Message : LSP.Server_Messages.Server_Message_Access; - Is_Done : Boolean := False; + Handler : Server_Message_Visitor_Access; + Priority : LSP.Server_Jobs.Job_Priority; + Message : LSP.Server_Messages.Server_Message_Access; + Is_Done : Boolean := False; end record; type Sequential_Job_Access is access all Sequential_Job'Class; overriding function Priority (Self : Sequential_Job) return LSP.Server_Jobs.Job_Priority is - (LSP.Server_Jobs.Fence); - -- In-order execution for this kind of jobs + (Self.Priority); overriding function Message (Self : Sequential_Job) return LSP.Server_Messages.Server_Message_Access is (Self.Message); @@ -56,14 +56,15 @@ package body LSP.Sequential_Message_Handlers is ---------------- overriding function Create_Job - (Self : Sequential_Message_Handler; + (Self : Default_Message_Handler; Message : LSP.Server_Messages.Server_Message_Access) return LSP.Server_Jobs.Server_Job_Access is Result : constant Sequential_Job_Access := new Sequential_Job' - (Handler => Self.Handler, - Message => Message, - Is_Done => False); + (Handler => Self.Handler, + Priority => Self.Priority, + Message => Message, + Is_Done => False); begin return LSP.Server_Jobs.Server_Job_Access (Result); end Create_Job; @@ -90,11 +91,13 @@ package body LSP.Sequential_Message_Handlers is ---------------- procedure Initialize - (Self : in out Sequential_Message_Handler'Class; + (Self : in out Default_Message_Handler'Class; Handler : not null access - LSP.Server_Message_Visitors.Server_Message_Visitor'Class) is + LSP.Server_Message_Visitors.Server_Message_Visitor'Class; + Priority : LSP.Server_Jobs.Job_Priority := LSP.Server_Jobs.Fence) is begin Self.Handler := Handler; + Self.Priority := Priority; end Initialize; -end LSP.Sequential_Message_Handlers; +end LSP.Default_Message_Handlers; diff --git a/source/server/lsp-sequential_message_handlers.ads b/source/server/lsp-default_message_handlers.ads similarity index 69% rename from source/server/lsp-sequential_message_handlers.ads rename to source/server/lsp-default_message_handlers.ads index 5be54795a..ac88b47f2 100644 --- a/source/server/lsp-sequential_message_handlers.ads +++ b/source/server/lsp-default_message_handlers.ads @@ -20,19 +20,24 @@ with LSP.Server_Message_Handlers; with LSP.Server_Message_Visitors; with LSP.Server_Messages; -package LSP.Sequential_Message_Handlers is +package LSP.Default_Message_Handlers is pragma Preelaborate; - type Sequential_Message_Handler is + type Default_Message_Handler is new LSP.Server_Message_Handlers.Server_Message_Handler with private; - -- This message handler processes messages in the order they are received. - -- TO do this for each message it creates a job with Fence priority. + -- This message handler creates jobs to process messages using a hanlder + -- (Server_Message_Visitor) provided during initialization. When used with + -- Fence priority it processes messages in the order they are received. procedure Initialize - (Self : in out Sequential_Message_Handler'Class; - Handler : not null access - LSP.Server_Message_Visitors.Server_Message_Visitor'Class); + (Self : in out Default_Message_Handler'Class; + Handler : not null access + LSP.Server_Message_Visitors.Server_Message_Visitor'Class; + Priority : LSP.Server_Jobs.Job_Priority := LSP.Server_Jobs.Fence); + -- Provide Handler and Priority to be used to handle requests and + -- notifications. By default use Fence priority that means + -- in-order execution for all kinds of messages. private @@ -40,15 +45,16 @@ private LSP.Server_Message_Visitors.Server_Message_Visitor'Class with Storage_Size => 0; - type Sequential_Message_Handler is + type Default_Message_Handler is new LSP.Server_Message_Handlers.Server_Message_Handler with record - Handler : Server_Message_Visitor_Access; + Handler : Server_Message_Visitor_Access; + Priority : LSP.Server_Jobs.Job_Priority; end record; overriding function Create_Job - (Self : Sequential_Message_Handler; + (Self : Default_Message_Handler; Message : LSP.Server_Messages.Server_Message_Access) return LSP.Server_Jobs.Server_Job_Access; -end LSP.Sequential_Message_Handlers; +end LSP.Default_Message_Handlers; diff --git a/source/server/lsp-servers.ads b/source/server/lsp-servers.ads index c3df8978d..706e44518 100644 --- a/source/server/lsp-servers.ads +++ b/source/server/lsp-servers.ads @@ -42,7 +42,7 @@ private with Ada.Containers.Unbounded_Synchronized_Queues; private with GNAT.Semaphores; private with System; private with LSP.Job_Schedulers; -private with LSP.Sequential_Message_Handlers; +private with LSP.Default_Message_Handlers; private with LSP.Server_Notifications; private with LSP.Server_Requests; private with VSS.Stream_Element_Vectors; @@ -234,7 +234,7 @@ private Tracer : LSP.Tracers.Tracer_Access; Scheduler : LSP.Job_Schedulers.Job_Scheduler; Default_Handler : aliased - LSP.Sequential_Message_Handlers.Sequential_Message_Handler; + LSP.Default_Message_Handlers.Default_Message_Handler; end record; overriding procedure On_Message From ed0cdad473f62bcca05a92da2bfc588f27082391 Mon Sep 17 00:00:00 2001 From: Maxim Reznik Date: Tue, 25 Jun 2024 13:13:36 +0300 Subject: [PATCH 3/5] Use `Low` priority as the default priority. Use `Fence` priority for * `didOpen` * `didClose` * `didChangeWorkspaceFolders` * `exit` * `initialize` Before this patch the default priority was `Fence`. Refs #1141 --- source/ada/lsp-ada_driver.adb | 40 +++++++++++++++++++++++++++++++++-- source/server/lsp-servers.adb | 5 +++-- source/server/lsp-servers.ads | 6 ++++-- 3 files changed, 45 insertions(+), 6 deletions(-) diff --git a/source/ada/lsp-ada_driver.adb b/source/ada/lsp-ada_driver.adb index 889b05461..065332d24 100644 --- a/source/ada/lsp-ada_driver.adb +++ b/source/ada/lsp-ada_driver.adb @@ -74,6 +74,7 @@ with LSP.Ada_Handlers.Source_Dirs_Commands; with LSP.Ada_Handlers.Suspend_Executions; with LSP.Ada_Tokens_Full; with LSP.Ada_Tokens_Range; +with LSP.Default_Message_Handlers; with LSP.GNATCOLL_Trace_Streams; with LSP.GNATCOLL_Tracers; with LSP.GPR_Handlers; @@ -82,14 +83,20 @@ with LSP.GPR_Did_Change_Document; with LSP.Memory_Statistics; with LSP.Predefined_Completion; with LSP.Secure_Message_Loggers; +with LSP.Server_Jobs; with LSP.Server_Notifications.DidChange; with LSP.Server_Notifications.DidChangeConfiguration; -with LSP.Server_Requests.Definition; +with LSP.Server_Notifications.DidChangeWorkspaceFolders; +with LSP.Server_Notifications.DidClose; +with LSP.Server_Notifications.DidOpen; +with LSP.Server_Notifications.Exits; with LSP.Server_Requests.Declaration; +with LSP.Server_Requests.Definition; with LSP.Server_Requests.DocumentSymbol; with LSP.Server_Requests.ExecuteCommand; with LSP.Server_Requests.FoldingRange; with LSP.Server_Requests.Hover; +with LSP.Server_Requests.Initialize; with LSP.Server_Requests.References; with LSP.Server_Requests.Tokens_Full; with LSP.Server_Requests.Tokens_Range; @@ -232,6 +239,10 @@ procedure LSP.Ada_Driver is LSP.Ada_Tokens_Range.Ada_Tokens_Range_Handler (Ada_Handler'Unchecked_Access); + Ada_Fence_Message_Handler : aliased + LSP.Default_Message_Handlers.Default_Message_Handler; + -- A shared handler with Fense priority + GPR_Did_Change_Doc_Handler : aliased LSP.GPR_Did_Change_Document.GPR_Did_Change_Handler (GPR_Handler'Unchecked_Access); @@ -451,6 +462,30 @@ begin LSP.Predefined_Completion.Load_Predefined_Completion_Db (Server_Trace); + Ada_Fence_Message_Handler.Initialize + (Handler => Ada_Handler'Unchecked_Access, + Priority => LSP.Server_Jobs.Fence); + + Server.Register_Handler + (LSP.Server_Requests.Initialize.Request'Tag, + Ada_Fence_Message_Handler'Unchecked_Access); + + Server.Register_Handler + (LSP.Server_Notifications.DidOpen.Notification'Tag, + Ada_Fence_Message_Handler'Unchecked_Access); + + Server.Register_Handler + (LSP.Server_Notifications.DidClose.Notification'Tag, + Ada_Fence_Message_Handler'Unchecked_Access); + + Server.Register_Handler + (LSP.Server_Notifications.DidChangeWorkspaceFolders.Notification'Tag, + Ada_Fence_Message_Handler'Unchecked_Access); + + Server.Register_Handler + (LSP.Server_Notifications.Exits.Notification'Tag, + Ada_Fence_Message_Handler'Unchecked_Access); + Server.Register_Handler (LSP.Server_Notifications.DidChangeConfiguration.Notification'Tag, Ada_Did_Change_Handler'Unchecked_Access); @@ -501,7 +536,8 @@ begin In_Logger => (if In_Trace.Is_Active then In_Logger'Unchecked_Access else null), Out_Logger => (if Out_Trace.Is_Active - then Out_Logger'Unchecked_Access else null)); + then Out_Logger'Unchecked_Access else null), + Priority => LSP.Server_Jobs.Low); end if; exception when E : others => diff --git a/source/server/lsp-servers.adb b/source/server/lsp-servers.adb index a7d6db935..21691b3ac 100644 --- a/source/server/lsp-servers.adb +++ b/source/server/lsp-servers.adb @@ -585,10 +585,11 @@ package body LSP.Servers is Handler : not null Server_Message_Visitor_Access; Tracer : not null LSP.Tracers.Tracer_Access; In_Logger : Server_Message_Visitor_Access; - Out_Logger : Client_Message_Visitor_Access) is + Out_Logger : Client_Message_Visitor_Access; + Priority : LSP.Server_Jobs.Job_Priority := LSP.Server_Jobs.Fence) is begin Self.Tracer := Tracer; - Self.Default_Handler.Initialize (Handler); + Self.Default_Handler.Initialize (Handler, Priority); Self.Processing_Task.Start (Handler); Self.Output_Task.Start (Out_Logger); diff --git a/source/server/lsp-servers.ads b/source/server/lsp-servers.ads index 706e44518..88cc9effe 100644 --- a/source/server/lsp-servers.ads +++ b/source/server/lsp-servers.ads @@ -83,12 +83,14 @@ package LSP.Servers is Handler : not null Server_Message_Visitor_Access; Tracer : not null LSP.Tracers.Tracer_Access; In_Logger : Server_Message_Visitor_Access; - Out_Logger : Client_Message_Visitor_Access); + Out_Logger : Client_Message_Visitor_Access; + Priority : LSP.Server_Jobs.Job_Priority := LSP.Server_Jobs.Fence); -- Run the server using given Request and Notification handler. -- Tracer object provides tracing/logging capabilities for the main trace, -- all input & output traces for debugging purposes. -- In/out loggers are used to dump client-to-server and server-to-client - -- messages. + -- messages. Priority is used to run Handler on out-of-order scheduler. + -- Default priority (Fence) means in-order message handling. procedure Stop (Self : in out Server); -- Ask server to stop From f191b32afda0a41ae5fbdb95ae77a069a56eb438 Mon Sep 17 00:00:00 2001 From: Anthony Leonardo Gracio Date: Tue, 2 Jul 2024 15:03:17 +0000 Subject: [PATCH 4/5] Add defensive code for GPR2 diagnostics For eng/ide/ada_language_server#1379 --- .../lsp-ada_handlers-project_diagnostics.adb | 24 ++++++++++++------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/source/ada/lsp-ada_handlers-project_diagnostics.adb b/source/ada/lsp-ada_handlers-project_diagnostics.adb index 57898092d..b3ac0f02d 100644 --- a/source/ada/lsp-ada_handlers-project_diagnostics.adb +++ b/source/ada/lsp-ada_handlers-project_diagnostics.adb @@ -143,20 +143,26 @@ package body LSP.Ada_Handlers.Project_Diagnostics is Sloc : constant GPR2.Source_Reference.Object := GPR2.Message.Sloc (Msg); File : constant GPR2.Path_Name.Object := - (if Sloc.Is_Defined and then Sloc.Has_Source_Reference then + (if Sloc.Is_Defined and then Sloc.Has_Source_Reference + then GPR2.Path_Name.Create_File (GPR2.Filename_Type (Sloc.Filename)) else Self.Handler.Project_Tree.Root_Path); begin - Parent_Diagnostic.relatedInformation.Append - (LSP .Structures.DiagnosticRelatedInformation' - (location => LSP.Structures.Location' - (uri => LSP.Utils.To_URI (File), - a_range => LSP.Utils.To_Range (Sloc), - others => <>), - message => VSS.Strings.Conversions.To_Virtual_String - (Msg.Message))); + -- Display a diagnostic for GPR2 messages only if the file + -- attached to the message is defined. + if File.Is_Defined and then File.Has_Value then + Parent_Diagnostic.relatedInformation.Append + (LSP .Structures.DiagnosticRelatedInformation' + (location => LSP.Structures.Location' + (uri => LSP.Utils.To_URI (File), + a_range => LSP.Utils.To_Range (Sloc), + others => <>), + message => + VSS.Strings.Conversions.To_Virtual_String + (Msg.Message))); + end if; end; -- If we have one error in the GPR2 messages, the parent From f2e1a552a390666c6320bad40096b64d367cf359 Mon Sep 17 00:00:00 2001 From: Anthony Leonardo Gracio Date: Fri, 21 Jun 2024 15:15:34 +0000 Subject: [PATCH 5/5] Remove 'Compiler current file' task on save This task is no longer provided. (no-issue-check) --- .vscode/settings.json.tmpl | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.vscode/settings.json.tmpl b/.vscode/settings.json.tmpl index b9d4e5b89..12b7c5575 100644 --- a/.vscode/settings.json.tmpl +++ b/.vscode/settings.json.tmpl @@ -80,8 +80,7 @@ "triggerTaskOnSave.tasks": { // To work with automatically provided tasks, they // must be provided without the `ada: ` prefix. - "Compile current file": ["*.adb"], - "Check current file": ["*.ads"] + "Check current file": ["*.ads", "*.adb"] }, "triggerTaskOnSave.restart": true, "files.watcherExclude": {