Merge branch 'topic/job_fix' into 'master'

Change job scheduler to complete fence job See merge request eng/ide/ada_language_server!1554
AdaCore · Apr 25, 2024 · 7b861b8 · 7b861b8
2 parents e7c3928 + 9f8abab
commit 7b861b8
Show file tree

Hide file tree

Showing 3 changed files with 44 additions and 48 deletions.
diff --git a/source/server/lsp-job_schedulers.adb b/source/server/lsp-job_schedulers.adb
@@ -52,7 +52,8 @@ package body LSP.Job_Schedulers is
 
    procedure Create_Job
      (Self    : in out Job_Scheduler'Class;
-      Message : in out LSP.Server_Messages.Server_Message_Access)
+      Message : in out LSP.Server_Messages.Server_Message_Access;
+      Waste   : out LSP.Server_Messages.Server_Message_Access)
    is
       Cursor : constant Handler_Maps.Cursor :=
         Self.Handlers.Find (Message'Tag);
@@ -61,6 +62,7 @@ package body LSP.Job_Schedulers is
    begin
       if Handler_Maps.Has_Element (Cursor) then
 
+         Self.Complete_Last_Fence_Job (Message, Waste);
          Job := Handler_Maps.Element (Cursor).Create_Job (Message);
 
          if Job.Assigned then
@@ -123,9 +125,9 @@ package body LSP.Job_Schedulers is
       Job : LSP.Server_Jobs.Server_Job_Access renames Self.Blocker;
       Status : LSP.Server_Jobs.Execution_Status := Continue;
    begin
-      if not Job.Assigned then
-         Waste := null;
+      Waste := null;
 
+      if not Job.Assigned then
          return;
       end if;
 
@@ -140,12 +142,6 @@ package body LSP.Job_Schedulers is
          end loop;
       end if;
 
-      Self.Complete_Last_Fence_Job (Job.Message, Waste);
-
-      if Waste.Assigned and Job.Priority /= Fence then
-         return;
-      end if;
-
       while Status /= LSP.Server_Jobs.Done loop
          Job.Execute (Client, Status);
       end loop;
@@ -164,27 +160,24 @@ package body LSP.Job_Schedulers is
    -----------------
 
    procedure Process_Job
-     (Self    : in out Job_Scheduler'Class;
-      Client  :
+     (Self   : in out Job_Scheduler'Class;
+      Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
-      Waste   : out LSP.Server_Messages.Server_Message_Access)
+      Waste  : out LSP.Server_Messages.Server_Message_Access)
    is
       Status : LSP.Server_Jobs.Execution_Status;
    begin
-      for List of reverse Self.Jobs when not List.Is_Empty loop
-         declare
-            Job : LSP.Server_Jobs.Server_Job_Access := List.First_Element;
-         begin
-            Self.Complete_Last_Fence_Job (Job.Message, Waste);
-
-            if Waste.Assigned then
-               return;
-            end if;
+      Self.Complete_Last_Fence_Job (null, Waste);
 
-            List.Delete_First;
-            Job.Execute (Client, Status);
+      if not Waste.Assigned then
+         for List of reverse Self.Jobs when not List.Is_Empty loop
+            declare
+               Job : LSP.Server_Jobs.Server_Job_Access := List.First_Element;
+            begin
+               List.Delete_First;
+               Job.Execute (Client, Status);
 
-            case Status is
+               case Status is
 
                when LSP.Server_Jobs.Done =>
                   Waste := Job.Message;
@@ -193,13 +186,12 @@ package body LSP.Job_Schedulers is
                when LSP.Server_Jobs.Continue =>
                   Waste := null;
                   List.Append (Job);  --  Push the job back to the queue
-            end case;
+               end case;
 
-            exit;
-         end;
-      end loop;
-
-      Self.Complete_Last_Fence_Job (null, Waste);
+               exit;
+            end;
+         end loop;
+      end if;
    end Process_Job;
 
    ----------------------

diff --git a/source/server/lsp-job_schedulers.ads b/source/server/lsp-job_schedulers.ads
@@ -40,33 +40,36 @@ package LSP.Job_Schedulers is
 
    procedure Create_Job
      (Self    : in out Job_Scheduler'Class;
-      Message : in out LSP.Server_Messages.Server_Message_Access);
+      Message : in out LSP.Server_Messages.Server_Message_Access;
+      Waste   : out LSP.Server_Messages.Server_Message_Access);
    --  Create a job to process a server message. The scheduler takes ownership
    --  of the message and will return it to the server when the job is done.
    --  If there is no handler for the message, then the scheduler doesn't
    --  accept message and server should destroy it.
+   --  This call completes a high priority job (if any) and returns its message
+   --  in Waste to be destroyed.
 
    procedure Enqueue
      (Self : in out Job_Scheduler'Class;
       Job  : not null LSP.Server_Jobs.Server_Job_Access);
    --  Put Job into the job queue.
 
    procedure Process_High_Priority_Job
-     (Self    : in out Job_Scheduler'Class;
-      Client  :
+     (Self   : in out Job_Scheduler'Class;
+      Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
-      Waste   : out LSP.Server_Messages.Server_Message_Access);
+      Waste  : out LSP.Server_Messages.Server_Message_Access);
    --  Execute jobs with highest priority (Immediate, Fence).
    --  When a job is done the routine returns (in Waste) the message to be
    --  deallocated by the server. The Client is used to send messages during
    --  the execution of the job.
 
    procedure Process_Job
-     (Self    : in out Job_Scheduler'Class;
-      Client  :
+     (Self   : in out Job_Scheduler'Class;
+      Client :
         in out LSP.Client_Message_Receivers.Client_Message_Receiver'Class;
-      Waste   : out LSP.Server_Messages.Server_Message_Access);
-   --  Execute jobs with ordinal priority (Low, High).
+      Waste  : out LSP.Server_Messages.Server_Message_Access);
+   --  Execute (already created) jobs with ordinal priority (Low, High).
    --  When a job is done the routine returns (in Waste) the message to be
    --  deallocated by the server. The Client is used to send messages during
    --  the execution of the job.

diff --git a/source/server/lsp-servers.adb b/source/server/lsp-servers.adb
@@ -821,14 +821,14 @@ package body LSP.Servers is
       procedure Process_Message (Message : in out Server_Message_Access);
       --  Create a job for the message and execute all highest priority jobs
 
-      procedure Execute_Jobs (Message : in out Server_Message_Access);
+      procedure Execute_Jobs (Message : out Server_Message_Access);
       --  Execute low priority jobs (if any) till a new message arrive
 
       ------------------
       -- Execute_Jobs --
       ------------------
 
-      procedure Execute_Jobs (Message : in out Server_Message_Access) is
+      procedure Execute_Jobs (Message : out Server_Message_Access) is
       begin
          loop
             select
@@ -860,24 +860,25 @@ package body LSP.Servers is
       ---------------------
 
       procedure Process_Message (Message : in out Server_Message_Access) is
+         Waste : Server_Message_Access;
       begin
-         Server.Scheduler.Create_Job (Message);
+         Server.Scheduler.Create_Job (Message, Waste);
+
+         if Waste.Assigned then
+            Server.Destroy_Queue.Enqueue (Waste);
+         end if;
 
          if Message.Assigned then
             --  Scheduler wasn't able to process message, destroy it
             Server.Destroy_Queue.Enqueue (Message);
          end if;
 
          loop
-            declare
-               Waste : Server_Message_Access;
-            begin
-               Server.Scheduler.Process_High_Priority_Job (Server.all, Waste);
+            Server.Scheduler.Process_High_Priority_Job (Server.all, Waste);
 
-               exit when not Waste.Assigned;
+            exit when not Waste.Assigned;
 
-               Server.Destroy_Queue.Enqueue (Waste);
-            end;
+            Server.Destroy_Queue.Enqueue (Waste);
          end loop;
 
       exception