From: Ronan Desplanques <[email protected]>
Before this patch, Sem_Ch12 jumped through questionable hoops in the way
it used its Generics_Renaming table that involved defensive calls to the
'Valid attribute. No known bug has been caused by this, but valgrind
reported incorrect memory operations because of it.
After analysis, the problem seems to be a mix 0-based and 1-based
indexing in the uses of Generic_Renamings and a convoluted interface for
the Set_Instance_Of procedure, leading to an unclear status for
Generic_Renamings.Table (0).
This patch fixes those problems and removes the accompanying defensive
code.
gcc/ada/ChangeLog:
* sem_ch12.adb (Build_Local_Package)
(Analyze_Package_Instantiation, Analyze_Subprogram_Instantiation):
Fix Set_Last calls.
(Set_Instance_Of): Use Table.Table.Append.
(Save_And_Reset): Remove useless call. Remove defensive code.
(Restore): Remove incorrect Set_Last call and adapt to
Set_Instance_Of change.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_ch12.adb | 37 +++++++------------------------------
1 file changed, 7 insertions(+), 30 deletions(-)
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 9acf1932678..fa68c3eea20 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 (0);
+ Generic_Renamings.Set_Last (-1);
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 (0);
+ Generic_Renamings.Set_Last (-1);
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 (0);
+ Generic_Renamings.Set_Last (-1);
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 (0);
+ Generic_Renamings.Set_Last (-1);
Generic_Renamings_HTable.Reset;
end if;
@@ -18721,9 +18721,8 @@ package body Sem_Ch12 is
procedure Set_Instance_Of (A : Entity_Id; B : Entity_Id) is
begin
- Generic_Renamings.Table (Generic_Renamings.Last) := (A, B, Assoc_Null);
+ Generic_Renamings.Append ((A, B, Assoc_Null));
Generic_Renamings_HTable.Set (Generic_Renamings.Last);
- Generic_Renamings.Increment_Last;
end Set_Instance_Of;
--------------------
@@ -19364,31 +19363,12 @@ package body Sem_Ch12 is
(Assoc_Ptr (Index));
Result_Pair : Binding_Pair renames Result (Index);
begin
- -- If we have called Increment_Last but have not yet
- -- initialized the new last element of the table, then
- -- that last element might be invalid. Saving and
- -- restoring (especially restoring, it turns out) invalid
- -- values can result in exceptions if predicate checking
- -- is enabled, so replace invalid values with Empty.
-
- if Indexed_Assoc.Gen_Id'Valid then
- Result_Pair.Formal_Id := Indexed_Assoc.Gen_Id;
- else
- pragma Assert (Index = Result'Last);
- Result_Pair.Formal_Id := Empty;
- end if;
-
- if Indexed_Assoc.Act_Id'Valid then
- Result_Pair.Actual_Id := Indexed_Assoc.Act_Id;
- else
- pragma Assert (Index = Result'Last);
- Result_Pair.Actual_Id := Empty;
- end if;
+ Result_Pair.Formal_Id := Indexed_Assoc.Gen_Id;
+ Result_Pair.Actual_Id := Indexed_Assoc.Act_Id;
end;
end loop;
Generic_Renamings.Init;
- Generic_Renamings.Set_Last (-1);
Generic_Renamings_HTable.Reset;
end return;
end Save_And_Reset;
@@ -19400,13 +19380,10 @@ package body Sem_Ch12 is
procedure Restore (Saved : Context) is
begin
Generic_Renamings.Init;
- Generic_Renamings.Set_Last (0);
Generic_Renamings_HTable.Reset;
- Generic_Renamings.Increment_Last;
for Pair of Saved loop
Set_Instance_Of (Pair.Formal_Id, Pair.Actual_Id);
end loop;
- Generic_Renamings.Decrement_Last;
end Restore;
end Instance_Context;
--
2.51.0
