Merge branch 'topic/alire-race-condition' into 'master'

Perform Alire workspace sync in initialize request

See merge request eng/ide/ada_language_server!2009

Author: eliericha

CHANGELOG.md

@@ -7,6 +7,10 @@ section below it for the last release. -->
 
 * Added `onEnterRules` for Ada/GPR files to split long comments by adding automatically a comment tag to the next line
 * Added support for new LSP request `textDocument/inlineValue`
+* Resolved a bug where the Ada and GPR language servers made concurrent Alire
+  invocations in the same workspace, causing sporadic errors. Alire invocations
+  are now made sequentially using file-based synchronization across ALS
+  processes.
 
 ## 26.0.202504171
 

integration/vscode/ada/src/ExtensionState.ts

@@ -122,6 +122,7 @@ export class ExtensionState {
 
     public start = async () => {
         await Promise.all([this.gprClient.start(), this.adaClient.start()]);
+
         this.registerTaskDisposables();
         this.context.subscriptions.push(
             vscode.languages.registerCodeLensProvider('ada', this.codelensProvider),

integration/vscode/ada/src/clients.ts

@@ -136,6 +136,11 @@ export function createClient(
              * from .als.json or other applicable configuration files.
              */
             ({ ada: getExplicitlySetConfiguration() }),
+        /**
+         * Include a workDoneToken property in the 'initialize' request for the
+         * server to report progress.
+         */
+        progressOnInitialization: true,
     };
 
     // Create the language client

integration/vscode/ada/src/extension.ts

@@ -168,14 +168,14 @@ async function activateExtension(context: vscode.ExtensionContext) {
     adaExtState.adaClient.clientOptions.middleware = alsMiddleware;
     adaExtState.adaClient.registerFeature(new ALSClientFeatures());
 
-    await adaExtState.start();
-
     /**
      * Register commands first so that commands such as displaying the extension
      * Output become available even if the language servers fail to start.
      */
     registerCommands(context, adaExtState);
 
+    await adaExtState.start();
+
     await vscode.commands.executeCommand('setContext', ADA_CONTEXT, true);
 
     /**

source/ada/lsp-ada_handlers-project_loading.adb

@@ -63,6 +63,9 @@ package body LSP.Ada_Handlers.Project_Loading is
      GNATCOLL.Traces.Create ("ALS.RUNTIME_INDEXING", GNATCOLL.Traces.On);
    --  Trace to enable/disable runtime indexing. Useful for the testsuite.
 
+   Fallback_Msg : constant VSS.Strings.Virtual_String :=
+     "Falling back to other methods to load a project";
+
    type GPR2_Reporter is new GPR2.Reporter.Object with record
       Log : GPR2.Log.Object;
    end record;
@@ -136,8 +139,8 @@ package body LSP.Ada_Handlers.Project_Loading is
 
       C : constant Context_Access := new Context (Self.Tracer);
 
-      Reader : LSP.Ada_Handlers.File_Readers.LSP_File_Reader
-        (Self'Unchecked_Access);
+      Reader :
+        LSP.Ada_Handlers.File_Readers.LSP_File_Reader (Self'Unchecked_Access);
 
       Dirs : File_Sets.Set;
 
@@ -160,17 +163,17 @@ package body LSP.Ada_Handlers.Project_Loading is
       Create_In_Memory_Project
         ("fallback_context", Dirs, Project_Tree, Success);
 
-      pragma Assert
-        (Success, "Can't create an empty project for the fallback context");
+      pragma
+        Assert
+          (Success, "Can't create an empty project for the fallback context");
 
       --  Create a basic GPR2_Provider_And_Projects containing only the
       --  implicit project and load it.
       declare
          Provider : Libadalang.Project_Provider.GPR2_Provider_And_Projects :=
            (Provider =>
               Libadalang.Project_Provider.Create_Project_Unit_Provider
-                (Tree    => Project_Tree,
-                 Project => Project_Tree.Root_Project),
+                (Tree => Project_Tree, Project => Project_Tree.Root_Project),
             Projects => <>);
       begin
          Provider.Projects.Append (Project_Tree.Root_Project);
@@ -224,34 +227,54 @@ package body LSP.Ada_Handlers.Project_Loading is
            (LSP.Ada_Project_Loading.Configured_Project);
 
       elsif Is_Alire_Crate then
-         Tracer.Trace ("Workspace is an Alire crate");
-
-         Tracer.Trace ("Performing minimal Alire sync");
-         LSP.Alire.Conservative_Alire_Sync
-           (Self.Client.Root_Directory.Display_Full_Name, Alire_Error);
+         declare
 
-         if not Alire_Error.Is_Empty then
-            Tracer.Trace_Text ("Encountered errors: " & Alire_Error);
-            Self.Project_Status.Set_Alire_Messages ([Alire_Error]);
-         else
-            Tracer.Trace ("Determining project from 'alr show' output");
+            procedure Report_Alire_Errors;
 
-            LSP.Alire.Determine_Alire_Project
-              (Root    => Self.Client.Root_Directory.Display_Full_Name,
-               Error   => Alire_Error,
-               Project => Project_File);
+            procedure Report_Alire_Errors is
+            begin
+               --  If the error is multi-line, use a separate line for the
+               --  fallback message. Otherwise, keep a single line.
+               if Alire_Error.Split_Lines.Length > 1 then
+                  Alire_Error.Append (VSS.Characters.Latin.Line_Feed);
+               else
+                  Alire_Error.Append (": ");
+               end if;
+               Alire_Error.Append (Fallback_Msg);
 
-            if not Alire_Error.Is_Empty then
                Tracer.Trace_Text ("Encountered errors: " & Alire_Error);
                Self.Project_Status.Set_Alire_Messages ([Alire_Error]);
+            end Report_Alire_Errors;
+
+         begin
+
+            Tracer.Trace ("Workspace is an Alire crate");
+
+            Tracer.Trace ("Performing minimal Alire sync");
+            LSP.Alire.Conservative_Alire_Sync
+              (Self.Client.Root_Directory.Display_Full_Name, Alire_Error);
+
+            if not Alire_Error.Is_Empty then
+               Report_Alire_Errors;
             else
-               --  Report how we found the project
-               Self.Project_Status.Set_Project_Type
-                 (LSP.Ada_Project_Loading.Alire_Project);
-               Self.Project_Status.Set_Alire_Messages ([]);
-            end if;
+               Tracer.Trace ("Determining project from 'alr show' output");
 
-         end if;
+               LSP.Alire.Determine_Alire_Project
+                 (Root    => Self.Client.Root_Directory.Display_Full_Name,
+                  Error   => Alire_Error,
+                  Project => Project_File);
+
+               if not Alire_Error.Is_Empty then
+                  Report_Alire_Errors;
+               else
+                  --  Report how we found the project
+                  Self.Project_Status.Set_Project_Type
+                    (LSP.Ada_Project_Loading.Alire_Project);
+                  Self.Project_Status.Set_Alire_Messages ([]);
+               end if;
+
+            end if;
+         end;
 
       end if;
 
@@ -354,7 +377,8 @@ package body LSP.Ada_Handlers.Project_Loading is
 
          Load_Implicit_Project
            (Self,
-            (if Candidates.Length = 0 then LSP.Ada_Project_Loading.No_Project
+            (if Candidates.Length = 0
+             then LSP.Ada_Project_Loading.No_Project
              elsif Candidates.Length > 1
              then LSP.Ada_Project_Loading.Multiple_Projects
              else LSP.Ada_Project_Loading.Project_Not_Found));
@@ -857,8 +881,7 @@ package body LSP.Ada_Handlers.Project_Loading is
    is
       Project  : GPR2.Project.Tree.View_Builder.Object :=
         GPR2.Project.Tree.View_Builder.Create
-          (Project_Dir => GPR2.Path_Name.Create_Directory ("."),
-           Name        => Name);
+          (Project_Dir => GPR2.Path_Name.Create_Directory ("."), Name => Name);
       Values   : GPR2.Containers.Value_List;
       Opts     : GPR2.Options.Object;
       Reporter : GPR2_Reporter;

source/ada/lsp-ada_handlers.adb

@@ -2485,6 +2485,15 @@ package body LSP.Ada_Handlers is
       Token_Types     : LSP.Structures.Virtual_String_Vector;
       Token_Motifiers : LSP.Structures.Virtual_String_Vector;
    begin
+      if Value.workDoneToken.Is_Set then
+         Self.Sender.On_ProgressBegin_Work_Done
+           (Value.workDoneToken.Value,
+            (title       => "Initializing Ada Language Server",
+             cancellable => (Is_Set => True, Value => False),
+             message     => VSS.Strings.Empty_Virtual_String,
+             percentage  => (Is_Set => False)));
+      end if;
+
       Self.Client.Initialize (Value);
 
       Self.Highlighter.Initialize
@@ -2550,6 +2559,12 @@ package body LSP.Ada_Handlers is
          --  notification. See On_Initialized_Notification.
       end if;
 
+      if Value.workDoneToken.Is_Set then
+         Self.Sender.On_ProgressEnd_Work_Done
+            (Value.workDoneToken.Value,
+            (message => VSS.Strings.Empty_Virtual_String));
+      end if;
+
       Self.Sender.On_Initialize_Response (Id, Response);
 
       Log_Info.a_type := LSP.Enumerations.Log;