From: Ronan Desplanques <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 14d9ba4bb2f..327bc2d7093 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 4f20231365d..0ad24b31793 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 032bcf02adb..3575ad5f3db 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 fa68c3eea20..b5c276a04bd 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 0ce2b35305a..4d57a86529a 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 31891de87db..f803fc8f3f5 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 623ce14711b..94bb8287cd4 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
--
2.51.0
