[Ada] Fix crash on formal containers

This patch modifies several mechanisms in the compiler:

1) The handling of Ghost regions now records the start of the outermost ignored
   Ghost region which is currently in effect.

2) Generation of freeze actions for an arbitrary entity now inserts the actions
   prior to the start of the outermost ignored Ghost region when the freezing
   takes effect within an ignored Ghost region, but the entity being frozen is
   "living". This ensures that any freeze actions associated with the living
   entity will not be eliminated from the tree once ignored Ghost code is
   stripped away.

3) The Default_Initial_Condition and Invariant procedures are not treated as
   primitives even when they apply to tagged types. These procedures already
   employ class-wide precondition-like semantics to handle inheritance and
   overriding. In addition, the procedures cannot be invoked from source and
   should not be targets of dispatching calls.

2018-05-24  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* expander.adb (Expand): Update the save and restore of the Ghost
	region.
	* exp_ch3.adb (Freeze_Type): Likewise.
	* exp_disp.adb (Make_DT): Likewise.
	* exp_util.adb (Build_DIC_Procedure_Body): Likewise.
	(Build_DIC_Procedure_Declaration): Likewise.
	(Build_Invariant_Procedure_Body): Likewise.
	(Build_Invariant_Procedure_Declaration): Likewise.
	(Make_Predicate_Call): Likewise.
	* freeze.adb (Add_To_Result): Insert the freeze action of a living
	entity prior to the start of the enclosing ignored Ghost region.
	(Freeze_Entity): Update the save and restore of the Ghost region.
	* ghost.adb (Install_Ghost_Mode): Reimplemented.
	(Install_Ghost_Region): New routine.
	(Mark_And_Set_Ghost_Assignment): Install a region rather than a mode.
	(Mark_And_Set_Ghost_Body): Likewise.
	(Mark_And_Set_Ghost_Completion): Likewise.
	(Mark_And_Set_Ghost_Declaration): Likewise.
	(Mark_And_Set_Ghost_Instantiation): Likewise.
	(Mark_And_Set_Ghost_Procedure_Call): Likewise.
	(Name_To_Ghost_Mode): New routine.
	(Restore_Ghost_Region): New routine.
	* ghost.ads (Install_Ghost_Region): New routine.
	(Restore_Ghost_Region): New routine.
	* opt.ads: Add new global variable Ignored_Ghost_Region.
	* rtsfind.adb (Load_RTU): Update the save and restore of the Ghost
	region. Install a clean region.
	* sem.adb (Analyze): Likewise.
	(Do_Analyze): Likewise.
	* sem_ch3.adb (Analyze_Object_Declaration): Likewise
	(Derive_Progenitor_Subprograms): Use local variable Iface_Alias to
	capture the ultimate alias of the current primitive.
	(Process_Full_View): Update the save and restore of the Ghost region.
	Do not inherit DIC and invariant procedures.
	* sem_ch5.adb (Analyze_Assignment): Update the save and restore of the
	Ghost region.
	* sem_ch6.adb (Analyze_Procedure_Call): Likewise.
	(Analyze_Subprogram_Body_Helper): Likewise.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Likewise.
	* sem_ch12.adb (Analyze_Package_Instantiation): Likewise.
	(Analyze_Subprogram_Instantiation): Likewise.
	(Instantiate_Package_Body): Likewise.
	(Instantiate_Subprogram_Body): Likewise.
	* sem_ch13.adb (Build_Predicate_Functions): Likewise.
	(Build_Predicate_Function_Declaration): Likewise.
	* sem_disp.adb
	(Add_Dispatching_Operation): Do not consider DIC and invariant
	procedures.
	(Check_Dispatching_Operation): Use Add_Dispatching_Operation to collect
	a dispatching subprogram.
	(Check_Operation_From_Private_View): Likewise.
	(Override_Dispatching_Operation): Likewise.
	* sem_prag.adb (Analyze_Contract_Cases_In_Decl_Part): Update the save
	and restore of the Ghost region.
	(Analyze_Initial_Condition_In_Decl_Part): Likewise.
	(Analyze_Pragma): Update the save and restore of the Ghost region.
	(Analyze_Pre_Post_Condition_In_Decl_Part): Likewise.
	* sem_util.adb (Is_Suitable_Primitive): New routine.
	* sem_util.ads (Is_Suitable_Primitive): New routine.
	* sinfo.ads: Update the section of Ghost regions.

gcc/testsuite/

	* gnat.dg/formal_containers.adb: New testcase.

From-SVN: r260648

1 files changed, 13 insertions, 4 deletions

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 9c9fe24..69c2a56 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -106,7 +106,16 @@ package body Sem_Disp is
       --  for the construction of function wrappers). The list of primitive
       --  operations must not contain duplicates.
 
-      Append_Unique_Elmt (New_Op, List);
+      --  The Default_Initial_Condition and invariant procedures are not added
+      --  to the list of primitives even when they are generated for a tagged
+      --  type. These routines must not be targets of dispatching calls and
+      --  therefore must not appear in the dispatch table because they already
+      --  utilize class-wide-precondition semantics to handle inheritance and
+      --  overriding.
+
+      if Is_Suitable_Primitive (New_Op) then
+         Append_Unique_Elmt (New_Op, List);
+      end if;
    end Add_Dispatching_Operation;
 
    --------------------------
@@ -1472,7 +1481,7 @@ package body Sem_Disp is
          --  Attach operation to list of primitives of the synchronized type
          --  itself, for ASIS use.
 
-         Append_Elmt (Subp, Direct_Primitive_Operations (Tagged_Type));
+         Add_Dispatching_Operation (Tagged_Type, Subp);
 
       --  If no old subprogram, then we add this as a dispatching operation,
       --  but we avoid doing this if an error was posted, to prevent annoying
@@ -1783,7 +1792,7 @@ package body Sem_Disp is
          --  Add Old_Subp to primitive operations if not already present
 
          if Present (Tagged_Type) and then Is_Tagged_Type (Tagged_Type) then
-            Append_Unique_Elmt (Old_Subp, Primitive_Operations (Tagged_Type));
+            Add_Dispatching_Operation (Tagged_Type, Old_Subp);
 
             --  If Old_Subp isn't already marked as dispatching then this is
             --  the case of an operation of an untagged private type fulfilled
@@ -2541,7 +2550,7 @@ package body Sem_Disp is
                         Find_Dispatching_Type (Alias (Prev_Op)))
       then
          Remove_Elmt (Primitive_Operations (Tagged_Type), Elmt);
-         Append_Elmt (New_Op, Primitive_Operations (Tagged_Type));
+         Add_Dispatching_Operation (Tagged_Type, New_Op);
 
       --  The new primitive replaces the overridden entity. Required to ensure
       --  that overriding primitive is assigned the same dispatch table slot.