https://gcc.gnu.org/g:9d052b444f4cfb3bcd27a5d37851398241f80380
commit r16-4688-g9d052b444f4cfb3bcd27a5d37851398241f80380 Author: Ronan Desplanques <[email protected]> Date: Mon Sep 29 10:26:34 2025 +0200 ada: Add new abstractions to Table.Table 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. Diff: --- gcc/ada/atree.adb | 6 +++--- gcc/ada/fmap.adb | 4 ++-- gcc/ada/par_sco.adb | 3 +-- gcc/ada/sem_ch12.adb | 12 +++++++----- gcc/ada/sem_elab.adb | 2 +- gcc/ada/table.adb | 20 +++++++++++++++++++- gcc/ada/table.ads | 7 +++++++ 7 files changed, 40 insertions(+), 14 deletions(-) diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb index 14d9ba4bb2fd..327bc2d70936 100644 --- a/gcc/ada/atree.adb +++ b/gcc/ada/atree.adb @@ -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; diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index 4f20231365dd..0ad24b317933 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -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; diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb index 032bcf02adb6..3575ad5f3dbd 100644 --- a/gcc/ada/par_sco.adb +++ b/gcc/ada/par_sco.adb @@ -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; ----------------------------- diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index fa68c3eea200..b5c276a04bd9 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -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 diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 0ce2b35305a1..4d57a86529a2 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -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). diff --git a/gcc/ada/table.adb b/gcc/ada/table.adb index 31891de87db4..f803fc8f3f5f 100644 --- a/gcc/ada/table.adb +++ b/gcc/ada/table.adb @@ -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 -- -------------- diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads index 623ce14711b9..94bb8287cd48 100644 --- a/gcc/ada/table.ads +++ b/gcc/ada/table.ads @@ -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
