]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Add new abstractions to Table.Table
authorRonan Desplanques <desplanques@adacore.com>
Mon, 29 Sep 2025 08:26:34 +0000 (10:26 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Tue, 28 Oct 2025 10:24:05 +0000 (11:24 +0100)
This patch adds two new subprograms to Table.Table: Clear and Is_Empty.
Their selling point is that they don't require being aware of the bounds
of the instance of Table.Table, avoiding the off-by-one errors that can
happen when using Set_Last or Last directly.

This patch also replaces existing code by calls to these new subprograms
in a few places where it makes sense. It also adds a call to
Table.Table.First in the same spirit on the side.

gcc/ada/ChangeLog:

* table.ads (Clear, Is_Empty): New subprograms.
* table.adb (Clear, Is_Empty): Likewise.
(Init): Use new subprogram.
* atree.adb (Traverse_Func_With_Parent): Use new subprograms.
* fmap.adb (Empty_Tables): Use new subprogram.
* par_sco.adb (Process_Pending_Decisions): Likewise.
* sem_elab.adb (Check_Elab_Call): Likewise.
* sem_ch12.adb (Build_Local_Package, Analyze_Package_Instantiation,
Analyze_Subprogram_Instantiation): Likewise.
(Save_And_Reset): Use Table.Table.First.

gcc/ada/atree.adb
gcc/ada/fmap.adb
gcc/ada/par_sco.adb
gcc/ada/sem_ch12.adb
gcc/ada/sem_elab.adb
gcc/ada/table.adb
gcc/ada/table.ads

index 14d9ba4bb2fd90868c79fe6aeaf65a971c5dcc2d..327bc2d7093677de8b188b741c9a5c5e7776b80a 100644 (file)
@@ -2766,14 +2766,14 @@ package body Atree is
       --  it is global and hence a tree traversal with parents must be finished
       --  before the next tree traversal with parents starts.
 
-      pragma Assert (Parents_Stack.Last = 0);
-      Parents_Stack.Set_Last (0);
+      pragma Assert (Parents_Stack.Is_Empty);
+      Parents_Stack.Clear;
 
       Parents_Stack.Append (Parent (Node));
       Result := Traverse (Node);
       Parents_Stack.Decrement_Last;
 
-      pragma Assert (Parents_Stack.Last = 0);
+      pragma Assert (Parents_Stack.Is_Empty);
 
       return Result;
    end Traverse_Func_With_Parent;
index 4f20231365ddb22dd8442af18ba260efcfd777f0..0ad24b3179333f1178fb2ba9af0a9114c05fc811 100644 (file)
@@ -191,8 +191,8 @@ package body Fmap is
       begin
          Unit_Hash_Table.Reset;
          File_Hash_Table.Reset;
-         Path_Mapping.Set_Last (0);
-         File_Mapping.Set_Last (0);
+         Path_Mapping.Clear;
+         File_Mapping.Clear;
          Last_In_Table := 0;
       end Empty_Tables;
 
index 032bcf02adb6343bf737f285b59794112357fb8c..3575ad5f3dbd2ff6a0e16ed92244adb5fff69e64 100644 (file)
@@ -2888,8 +2888,7 @@ package body Par_SCO is
             end;
          end loop;
 
-         --  Clear the pending decisions list
-         Pending_Decisions.Set_Last (0);
+         Pending_Decisions.Clear;
       end Process_Pending_Decisions;
 
       -----------------------------
index fa68c3eea2007ae42c1b038488c8feb7d0dcba30..b5c276a04bd9c2642d7d3ff060f7ec30fe03673d 100644 (file)
@@ -3653,7 +3653,7 @@ package body Sem_Ch12 is
                                Instantiating => True);
 
             begin
-               Generic_Renamings.Set_Last (-1);
+               Generic_Renamings.Clear;
                Generic_Renamings_HTable.Reset;
                Instantiation_Node := N;
 
@@ -5014,7 +5014,7 @@ package body Sem_Ch12 is
       --  inherited from formal packages of parent units, and these are
       --  constructed when the parents are installed.
 
-      Generic_Renamings.Set_Last (-1);
+      Generic_Renamings.Clear;
       Generic_Renamings_HTable.Reset;
 
       --  Except for an abbreviated instance created to check a formal package,
@@ -6979,7 +6979,7 @@ package body Sem_Ch12 is
 
          --  Initialize renamings map, for error checking
 
-         Generic_Renamings.Set_Last (-1);
+         Generic_Renamings.Clear;
          Generic_Renamings_HTable.Reset;
 
          Create_Instantiation_Source (N, Gen_Unit, S_Adjustment);
@@ -7254,7 +7254,7 @@ package body Sem_Ch12 is
          Restore_Hidden_Primitives (Vis_Prims_List);
          Restore_Env;
          Env_Installed := False;
-         Generic_Renamings.Set_Last (-1);
+         Generic_Renamings.Clear;
          Generic_Renamings_HTable.Reset;
       end if;
 
@@ -19355,8 +19355,10 @@ package body Sem_Ch12 is
       --------------------
 
       function Save_And_Reset return Context is
+         First : constant Integer := Integer (Generic_Renamings.First);
+         Last  : constant Integer := Integer (Generic_Renamings.Last);
       begin
-         return Result : Context (0 .. Integer (Generic_Renamings.Last)) do
+         return Result : Context (First .. Last) do
             for Index in Result'Range loop
                declare
                   Indexed_Assoc : Assoc renames Generic_Renamings.Table
index 0ce2b35305a10391d1ae2137b9aefba954ec68ba..4d57a86529a21d5228e32ea23505c0c2e2325e14 100644 (file)
@@ -17469,7 +17469,7 @@ package body Sem_Elab is
       --  Stuff that happens only at the outer level
 
       if No (Outer_Scope) then
-         Elab_Visited.Set_Last (0);
+         Elab_Visited.Clear;
 
          --  Nothing to do if current scope is Standard (this is a bit odd, but
          --  it happens in the case of generic instantiations).
index 31891de87db4378d1c94320d0c2033e33c1f5057..f803fc8f3f5fedfb7b53ebd166735d5ea301c4d3 100644 (file)
@@ -130,7 +130,7 @@ package body Table is
 
       begin
          Locked   := False;
-         Last_Val := Min - 1;
+         Clear;
          Max      := Min + (Table_Initial * Table_Factor) - 1;
          Length   := Max - Min + 1;
 
@@ -372,6 +372,24 @@ package body Table is
          end if;
       end Set_Item;
 
+      -----------
+      -- Clear --
+      -----------
+
+      procedure Clear is
+      begin
+         Last_Val := Min - 1;
+      end Clear;
+
+      --------------
+      -- Is_Empty --
+      --------------
+
+      function Is_Empty return Boolean is
+      begin
+         return Last_Val = Min - 1;
+      end Is_Empty;
+
       --------------
       -- Set_Last --
       --------------
index 623ce14711b927bc559f2a5ed8723ae1380c8f6d..94bb8287cd489915506c0e1990987d8c558d31fc 100644 (file)
@@ -204,6 +204,13 @@ package Table is
       --  to Index. Item will replace any value already present in the table
       --  at this position.
 
+      procedure Clear;
+      --  Resets Last to its initial value, making the table have no elements.
+      --  No memory deallocation is performed.
+
+      function Is_Empty return Boolean;
+      --  Returns whether the table is empty
+
       type Saved_Table is private;
       --  Type used for Save/Restore subprograms