@@ -47,6 +47,7 @@ with Restrict; use Restrict;
with Sem; use Sem;
with Sem_Aux; use Sem_Aux;
with Sem_Ch7; use Sem_Ch7;
+with Sem_Ch12; use Sem_Ch12;
with Sem_Dist; use Sem_Dist;
with Sem_Util; use Sem_Util;
with Sinfo; use Sinfo;
@@ -1185,7 +1186,13 @@ package body Rtsfind is
else
Save_Private_Visibility;
- Semantics (Cunit (U.Unum));
+ declare
+ Saved_Instance_Context : constant Instance_Context.Context
+ := Instance_Context.Save_And_Reset;
+ begin
+ Semantics (Cunit (U.Unum));
+ Instance_Context.Restore (Saved_Instance_Context);
+ end;
Restore_Private_Visibility;
if Fatal_Error (U.Unum) = Error_Detected then
@@ -17753,4 +17753,66 @@ package body Sem_Ch12 is
raise Program_Error;
end case;
end Validate_Formal_Type_Default;
+
+ package body Instance_Context is
+
+ --------------------
+ -- Save_And_Reset --
+ --------------------
+
+ function Save_And_Reset return Context is
+ begin
+ return Result : Context (0 .. Integer (Generic_Renamings.Last)) do
+ for Index in Result'Range loop
+ declare
+ Indexed_Assoc : Assoc renames Generic_Renamings.Table
+ (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;
+ end;
+ end loop;
+
+ Generic_Renamings.Init;
+ Generic_Renamings.Set_Last (0);
+ Generic_Renamings_HTable.Reset;
+ end return;
+ end Save_And_Reset;
+
+ -------------
+ -- Restore --
+ -------------
+
+ 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;
end Sem_Ch12;
@@ -193,6 +193,31 @@ package Sem_Ch12 is
-- After processing an instantiation, or aborting one because of semantic
-- errors, remove the current Instantiation_Env from Instantation_Envs.
+ package Instance_Context is
+ -- If an entirely new context is entered (e.g., when Rtsfind invokes
+ -- semantics on a new compilation unit), then the current contents of
+ -- the generic renamings table must be saved and later restored.
+
+ type Context (<>) is private;
+
+ function Save_And_Reset return Context;
+ -- Save the current context information, then reinitialize
+ -- the current context, and finally return the saved value.
+
+ procedure Restore (Saved : Context);
+ -- Restore the context that was saved earlier.
+
+ private
+
+ type Binding_Pair is record
+ Formal_Id : Entity_Id;
+ Actual_Id : Entity_Id;
+ end record;
+
+ type Context is array (Natural range <>) of Binding_Pair;
+
+ end Instance_Context;
+
procedure Initialize;
-- Initializes internal data structures
@@ -217,7 +217,7 @@ package Table is
private
- Last_Val : Int;
+ Last_Val : Int := Int (Table_Low_Bound) - 1;
-- Current value of Last. Note that we declare this in the private part
-- because we don't want the client to modify Last except through one of
-- the official interfaces (since a modification to Last may require a
From: Steve Baird <baird@adacore.com> During analysis of an instantiation, Sem_Ch12 manages formal/actual binding information in package state (see Sem_Ch12.Generic_Renamings_HTable). A call to rtsfind can cause another unit to be loaded and compiled. If this occurs during the analysis of an instantiation, and if the loaded unit contains a second instantiation, then the Sem_Ch12 state needed for analyzing the first instantiation can be trashed during the analysis of the second instantiation. Rtsfind calls that can include the analysis of an instantiation need to save and restore Sem_Ch12's state. gcc/ada/ * sem_ch12.ads: Declare new Instance_Context package, which declares a private type Context with operations Save_And_Reset and Restore. * sem_ch12.adb: Provide body for new Instance_Context package. * rtsfind.adb (Load_RTU): Wrap an Instance_Context Save/Restore call pair around the call to Semantics. * table.ads: Add initial value for Last_Val (because Save_And_Reset expects Last_Val to be initialized). Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/rtsfind.adb | 9 ++++++- gcc/ada/sem_ch12.adb | 62 ++++++++++++++++++++++++++++++++++++++++++++ gcc/ada/sem_ch12.ads | 25 ++++++++++++++++++ gcc/ada/table.ads | 2 +- 4 files changed, 96 insertions(+), 2 deletions(-)