[COMMITTED] ada: Rtsfind should not trash state used in analyzing instantiations.

[COMMITTED] ada: Rtsfind should not trash state used in analyzing instantiations.

[Marc Poulhiès]

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(-)

diff --git a/gcc/ada/rtsfind.adb b/gcc/ada/rtsfind.adb
index 8933ca6ce16..7c9935e614c 100644
--- a/gcc/ada/rtsfind.adb
+++ b/gcc/ada/rtsfind.adb
@@ -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
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index cb05a71e96f..4ceddda2052 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -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;
diff --git a/gcc/ada/sem_ch12.ads b/gcc/ada/sem_ch12.ads
index 79f8c56c545..6639d546e31 100644
--- a/gcc/ada/sem_ch12.ads
+++ b/gcc/ada/sem_ch12.ads
@@ -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
 
diff --git a/gcc/ada/table.ads b/gcc/ada/table.ads
index 567d651259c..5e700b009cb 100644
--- a/gcc/ada/table.ads
+++ b/gcc/ada/table.ads
@@ -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
-- 
2.43.2