T826-026 Correction for cancelling Workspace_Symbols_Request

Author: ogorodnik

source/ada/lsp-ada_completions.adb

@@ -102,11 +102,11 @@ package body LSP.Ada_Completions is
       end loop;
    end Write_Completions;
 
-   -------------------
-   -- Write_Symbols --
-   -------------------
+   ---------------------------
+   -- Generic_Write_Symbols --
+   ---------------------------
 
-   procedure Write_Symbols
+   procedure Generic_Write_Symbols
      (Names  : Completion_Maps.Map;
       Result : in out LSP.Messages.Symbol_Vector) is
    begin
@@ -139,6 +139,6 @@ package body LSP.Ada_Completions is
             exit when Has_Been_Canceled;
          end;
       end loop;
-   end Write_Symbols;
+   end Generic_Write_Symbols;
 
 end LSP.Ada_Completions;

source/ada/lsp-ada_completions.ads

@@ -92,7 +92,7 @@ package LSP.Ada_Completions is
 
    generic
       with function Has_Been_Canceled return Boolean;
-   procedure Write_Symbols
+   procedure Generic_Write_Symbols
      (Names  : Completion_Maps.Map;
       Result : in out LSP.Messages.Symbol_Vector);
 

source/ada/lsp-ada_contexts.ads

@@ -232,7 +232,7 @@ package LSP.Ada_Contexts is
      (Self        : Context;
       Pattern     : LSP.Search.Search_Pattern'Class;
       Only_Public : Boolean;
-      Callback : not null access procedure
+      Callback    : not null access procedure
         (File : GNATCOLL.VFS.Virtual_File;
          Name : Libadalang.Analysis.Defining_Name;
          Stop : in out Boolean));

source/ada/lsp-ada_documents.adb

@@ -2018,6 +2018,7 @@ package body LSP.Ada_Documents is
       Pattern     : LSP.Search.Search_Pattern'Class;
       Limit       : Ada.Containers.Count_Type;
       Only_Public : Boolean;
+      Canceled    : access function return Boolean;
       Result      : in out LSP.Ada_Completions.Completion_Maps.Map)
    is
       use type LSP.Messages.Search_Kind;
@@ -2121,19 +2122,23 @@ package body LSP.Ada_Documents is
                then
                   Insert (Item);
                end if;
+
+               exit when Canceled.all;
             end loop;
 
          elsif Pattern.Match (Symbol_Maps.Key (Cursor)) then
             --  Symbol_Cache is case insensitive so if the key is matched
             --  this means that all elements are also matched the pattern
             for Item of Self.Symbol_Cache (Cursor) loop
                Insert (Item);
+
+               exit when Canceled.all;
             end loop;
 
          else
             --  Symbol_Cache is ordered so we will not find any
             --  matches more
-            exit when Use_Celling;
+            exit when Use_Celling or else Canceled.all;
          end if;
 
          Symbol_Maps.Next (Cursor);

source/ada/lsp-ada_documents.ads

@@ -147,6 +147,7 @@ package LSP.Ada_Documents is
       Pattern     : LSP.Search.Search_Pattern'Class;
       Limit       : Ada.Containers.Count_Type;
       Only_Public : Boolean;
+      Canceled    : access function return Boolean;
       Result  : in out LSP.Ada_Completions.Completion_Maps.Map);
    --  See Contexts.Get_Any_Symbol
 

source/ada/lsp-ada_handlers-invisibles.adb

@@ -82,6 +82,8 @@ package body LSP.Ada_Handlers.Invisibles is
            then Libadalang.Common.Previous (Token, True)
            else Token);
 
+      function Dummy_Canceled return Boolean is (False);
+
    begin
       if Libadalang.Common.Kind (Dot_Token) = Ada_Dot then
          --  Don't provide completion after a dot
@@ -140,6 +142,7 @@ package body LSP.Ada_Handlers.Invisibles is
                      Pattern,
                      Limit,
                      True,
+                     Dummy_Canceled'Access,
                      Names);
                end loop;
             end;

source/ada/lsp-ada_handlers.adb

@@ -60,6 +60,7 @@ with LSP.Messages.Client_Requests;
 with LSP.Messages.Server_Notifications;
 with LSP.Servers.FS_Watch;
 with LSP.Types;        use LSP.Types;
+with LSP.Generic_Cancel_Check;
 
 with Langkit_Support.Slocs;
 with Langkit_Support.Text;
@@ -3740,23 +3741,13 @@ package body LSP.Ada_Handlers is
          Name : Libadalang.Analysis.Defining_Name;
          Stop : in out Boolean);
 
-      function Has_Been_Canceled return Boolean;
-
-      procedure Write_Symbols is
-        new LSP.Ada_Completions.Write_Symbols (Has_Been_Canceled);
-
-      Count : Cancel_Countdown := 0;
       Names : LSP.Ada_Completions.Completion_Maps.Map;
 
-      -----------------------
-      -- Has_Been_Canceled --
-      -----------------------
+      package Canceled is new LSP.Generic_Cancel_Check (Request, 127);
 
-      function Has_Been_Canceled return Boolean is
-      begin
-         Count := Count - 1;
-         return Count = 0  and then Request.Canceled;
-      end Has_Been_Canceled;
+      procedure Write_Symbols is
+        new LSP.Ada_Completions.Generic_Write_Symbols
+          (Canceled.Has_Been_Canceled);
 
       --------------------------
       -- On_Inaccessible_Name --
@@ -3778,8 +3769,9 @@ package body LSP.Ada_Handlers is
                 Is_Visible   => False,
                 Use_Snippets => False,
                 Pos          => <>));
-            Stop := Has_Been_Canceled;
          end if;
+
+         Stop := Canceled.Has_Been_Canceled;
       end On_Inaccessible_Name;
 
       Pattern : constant Search_Pattern'Class := Build
@@ -3802,7 +3794,9 @@ package body LSP.Ada_Handlers is
             Only_Public => False,
             Callback    => On_Inaccessible_Name'Access);
 
-         exit when Request.Canceled;
+         if Canceled.Has_Been_Canceled then
+            return Response;
+         end if;
       end loop;
 
       for Doc of Self.Open_Documents loop
@@ -3815,8 +3809,13 @@ package body LSP.Ada_Handlers is
                Pattern,
                Ada.Containers.Count_Type'Last,
                False,
+               Canceled.Has_Been_Canceled'Access,
                Names);
          end;
+
+         if Canceled.Has_Been_Canceled then
+            return Response;
+         end if;
       end loop;
 
       Write_Symbols (Names, Response.result);

source/server/lsp-generic_cancel_check.adb

@@ -20,17 +20,26 @@ package body LSP.Generic_Cancel_Check is
    Count : Natural := Max_Skip_Count;
    --  Counter to restrict frequency of Request.Canceled checks
 
+   Is_Canceled : Boolean := False;
+
    -----------------------
    -- Has_Been_Canceled --
    -----------------------
 
    function Has_Been_Canceled return Boolean is
    begin
+      if Is_Canceled then
+         return True;
+      end if;
+
       Count := Count - 1;
 
       if Count = 0 then
-         Count := Max_Skip_Count;
-         return Request.Canceled;
+         Count       := Max_Skip_Count;
+         Is_Canceled := Request.Canceled;
+
+         return Is_Canceled;
+
       else
          return False;
       end if;

source/server/lsp-generic_cancel_check.ads

@@ -23,7 +23,7 @@
 with LSP.Messages.Server_Requests;
 
 generic
-   Request : in out LSP.Messages.Server_Requests.Server_Request'Class;
+   Request : LSP.Messages.Server_Requests.Server_Request'Class;
    --  A request to check cancelation
    Max_Skip_Count : Natural;
    --  How much checks to skip before make a real atomic flag check