atree.adb (Allocate_Initialize_Node): A newly created node is no longer marked as Ghost at this level.

2017-01-13  Hristian Kirtchev  <kirtchev@adacore.com>

	* atree.adb (Allocate_Initialize_Node): A newly created node is
	no longer marked as Ghost at this level.
	(Mark_New_Ghost_Node): New routine.
	(New_Copy): Mark the copy as Ghost.
	(New_Entity): Mark the entity as Ghost.
	(New_Node): Mark the node as Ghost.
	* einfo.adb (Is_Checked_Ghost_Entity): This attribute can now
	apply to unanalyzed entities.
	(Is_Ignored_Ghost_Entity): This attribute can now apply to unanalyzed
	entities.
	(Set_Is_Checked_Ghost_Entity): This attribute now
	applies to all entities as well as unanalyzed entities.
	(Set_Is_Ignored_Ghost_Entity): This attribute now applies to
	all entities as well as unanalyzed entities.
	* expander.adb Add with and use clauses for Ghost.
	(Expand): Install and revert the Ghost region associated with the node
	being expanded.
	* exp_ch3.adb (Expand_Freeze_Array_Type): Remove all Ghost-related code.
	(Expand_Freeze_Class_Wide_Type): Remoe all Ghost-related code.
	(Expand_Freeze_Enumeration_Type): Remove all Ghost-related code.
	(Expand_Freeze_Record_Type): Remove all Ghost-related code.
	(Freeze_Type): Install and revert the Ghost region associated
	with the type being frozen.
	* exp_ch5.adb Remove with and use clauses for Ghost.
	(Expand_N_Assignment_Statement): Remove all Ghost-related code.
	* exp_ch6.adb Remove with and use clauses for Ghost.
	(Expand_N_Procedure_Call_Statement): Remove all Ghost-relatd code.
	(Expand_N_Subprogram_Body): Remove all Ghost-related code.
	* exp_ch7.adb (Build_Invariant_Procedure_Body): Install and revert the
	Ghost region of the working type.
	(Build_Invariant_Procedure_Declaration): Install and revert
	the Ghost region of the working type.
	(Expand_N_Package_Body): Remove all Ghost-related code.
	* exp_ch8.adb Remove with and use clauses for Ghost.
	(Expand_N_Exception_Renaming_Declaration): Remove all Ghost-related
	code.
	(Expand_N_Object_Renaming_Declaration): Remove all Ghost-related code.
	(Expand_N_Package_Renaming_Declaration): Remove all Ghost-related code.
	(Expand_N_Subprogram_Renaming_Declaration): Remove all Ghost-related
	code.
	* exp_ch13.adb Remove with and use clauses for Ghost.
	(Expand_N_Freeze_Entity): Remove all Ghost-related code.
	* exp_disp.adb (Make_DT): Install and revert the Ghost region of
	the tagged type. Move the generation of various entities within
	the Ghost region of the type.
	* exp_prag.adb Remove with and use clauses for Ghost.
	(Expand_Pragma_Check): Remove all Ghost-related code.
	(Expand_Pragma_Contract_Cases): Remove all Ghost-related code.
	(Expand_Pragma_Initial_Condition): Remove all Ghost-related code.
	(Expand_Pragma_Loop_Variant): Remove all Ghost-related code.
	* exp_util.adb (Build_DIC_Procedure_Body): Install
	and revert the Ghost region of the working types.
	(Build_DIC_Procedure_Declaration): Install and revert the
	Ghost region of the working type.
	(Make_Invariant_Call): Install and revert the Ghost region of the
	associated type.
	(Make_Predicate_Call): Reimplemented. Install and revert the
	Ghost region of the associated type.
	* freeze.adb (Freeze_Entity): Install and revert the Ghost region
	of the entity being frozen.
	(New_Freeze_Node): Removed.
	* ghost.adb Remove with and use clauses for Opt.
	(Check_Ghost_Completion): Update the parameter profile
	and all references to formal parameters.
	(Ghost_Entity): Update the comment on usage.
	(Install_Ghost_Mode): New routines.
	(Is_Ghost_Assignment): New routine.
	(Is_Ghost_Declaration): New routine.
	(Is_Ghost_Pragma): New routine.
	(Is_Ghost_Procedure_Call): New routine.
	(Is_Ghost_Renaming): Removed.
	(Is_OK_Declaration): Reimplemented.
	(Is_OK_Pragma): Reimplemented.
	(Is_OK_Statement): Reimplemented.
	(Is_Subject_To_Ghost): Update the comment on usage.
	(Mark_And_Set_Ghost_Assignment): New routine.
	(Mark_And_Set_Ghost_Body): New routine.
	(Mark_And_Set_Ghost_Completion): New routine.
	(Mark_And_Set_Ghost_Declaration): New routine.
	(Mark_And_Set_Ghost_Instantiation): New routine.
	(Mark_And_Set_Ghost_Procedure_Call): New routine.
	(Mark_Full_View_As_Ghost): Removed.
	(Mark_Ghost_Declaration_Or_Body): New routine.
	(Mark_Ghost_Pragma): New routine.
	(Mark_Ghost_Renaming): New routine.
	(Mark_Pragma_As_Ghost): Removed.
	(Mark_Renaming_As_Ghost): Removed.
	(Propagate_Ignored_Ghost_Code): Update the comment on usage.
	(Prune_Node): Freeze nodes no longer need special pruning, they
	are processed by the general ignored Ghost code mechanism.
	(Restore_Ghost_Mode): New routine.
	(Set_Ghost_Mode): Reimplemented.
	(Set_Ghost_Mode_From_Entity): Removed.
	* ghost.ads Add with and use clauses for Ghost.
	(Check_Ghost_Completion): Update the parameter profile
	along with the comment on usage.
	(Install_Ghost_Mode): New routine.
	(Is_Ghost_Assignment): New routine.
	(Is_Ghost_Declaration): New routine.
	(Is_Ghost_Pragma): New routine.
	(Is_Ghost_Procedure_Call): New routine.
	(Mark_And_Set_Ghost_Assignment): New routine.
	(Mark_And_Set_Ghost_Body): New routine.
	(Mark_And_Set_Ghost_Completion): New routine.
	(Mark_And_Set_Ghost_Declaration): New routine.
	(Mark_And_Set_Ghost_Instantiation): New routine.
	(Mark_And_Set_Ghost_Procedure_Call): New routine.
	(Mark_Full_View_As_Ghost): Removed.
	(Mark_Ghost_Pragma): New routine.
	(Mark_Ghost_Renaming): New routine.
	(Mark_Pragma_As_Ghost): Removed.
	(Mark_Renaming_As_Ghost): Removed.
	(Restore_Ghost_Mode): New routine.
	(Set_Ghost_Mode): Redefined.
	(Set_Ghost_Mode_From_Entity): Removed.
	* sem.adb (Analyze): Install and revert the Ghost region of the
	node being analyzed.
	(Do_Analyze): Change the way a clean Ghost
	region is installed and reverted.
	* sem_ch3.adb (Analyze_Full_Type_Declaration): Remove
	all Ghost-related code.
	(Analyze_Incomplete_Type_Decl): Remove all Ghost-related code.
	(Analyze_Number_Declaration): Remove all Ghost-related code.
	(Analyze_Object_Declaration): Install and revert the Ghost region of
	a deferred object declaration's completion.
	(Array_Type_Declaration): Remove all Ghost-related code.
	(Build_Derived_Type): Update the comment on
	the propagation of Ghost attributes from a parent to a derived type.
	(Derive_Subprogram): Remove all Ghost-related code.
	(Make_Class_Wide_Type): Remove all Ghost-related code.
	(Make_Implicit_Base): Remove all Ghost-related code.
	(Process_Full_View): Install and revert the Ghost region of
	the partial view.  There is no longer need to check the Ghost
	completion here.
	* sem_ch5.adb (Analyze_Assignment): Install and revert the Ghost
	region of the left hand side.
	* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Remove
	all Ghost-related code.
	(Analyze_Expression_Function): Remove all Ghost-related code.
	(Analyze_Generic_Subprogram_Body): Remove all Ghost-related code.
	(Analyze_Procedure_Call): Install and revert the Ghost region of
	the procedure being called.
	(Analyze_Subprogram_Body_Helper): Install and revert the Ghost
	region of the spec or body.
	(Analyze_Subprogram_Declaration): Remove all Ghost-related code.
	(Build_Subprogram_Declaration): Remove all Ghost-related code.
	(Find_Corresponding_Spec): Remove all Ghost-related code.
	(Process_Formals): Remove all Ghost-related code.
	* sem_ch7.adb (Analyze_Package_Body_Helper): Install and revert
	the Ghost region of the spec.
	(Analyze_Package_Declaration): Remove all Ghost-related code.
	* sem_ch8.adb (Analyze_Exception_Renaming): Mark a renaming as
	Ghost when it aliases a Ghost entity.
	(Analyze_Generic_Renaming): Mark a renaming as Ghost when it aliases
	a Ghost entity.
	(Analyze_Object_Renaming): Mark a renaming as Ghost when
	it aliases a Ghost entity.
	(Analyze_Package_Renaming): Mark a renaming as Ghost when it aliases
	a Ghost entity.
	(Analyze_Subprogram_Renaming): Mark a renaming as Ghost when it
	aliases a Ghost entity.
	* sem_ch11.adb Remove with and use clauses for Ghost.
	(Analyze_Exception_Declaration): Remove all Ghost-related code.
	* sem_ch12.adb (Analyze_Generic_Package_Declaration): Remove all
	Ghost-related code.
	(Analyze_Generic_Subprogram_Declaration): Remove all Ghost-related
	code.
	(Analyze_Package_Instantiation): Install and revert the Ghost region
	of the package instantiation.
	(Analyze_Subprogram_Instantiation): Install
	and revert the Ghost region of the subprogram instantiation.
	(Instantiate_Package_Body): Code clean up. Install and revert the
	Ghost region of the package body.
	(Instantiate_Subprogram_Body): Code clean up. Install and revert the
	Ghost region of the subprogram body.
	* sem_ch13.adb (Build_Predicate_Functions): Install
	and revert the Ghost region of the related type.
	(Build_Predicate_Function_Declaration): Code clean up. Install
	and rever the Ghost region of the related type.
	* sem_prag.adb (Analyze_Contract_Cases_In_Decl_Part):
	Install and revert the Ghost region of the pragma.
	(Analyze_Initial_Condition_In_Decl_Part): Install and revert the
	Ghost region of the pragma.
	(Analyze_Pragma): Install and revert the Ghost region of various
	pragmas.  Mark a pragma as Ghost when it is related to a Ghost entity
	or encloses a Ghost entity.
	(Analyze_Pre_Post_Condition): Install and revert the Ghost
	region of the pragma.
	(Analyze_Pre_Post_Condition_In_Decl_Part): Install and revert the
	Ghost region of the pragma.
	* sem_res.adb (Resolve): Remove all Ghost-related code.
	* sem_util.adb (Is_Declaration): Reimplemented.
	(Is_Declaration_Other_Than_Renaming): New routine.
	* sem_util.ads (Is_Declaration_Other_Than_Renaming): New routine.
	* sinfo.adb (Is_Checked_Ghost_Pragma): New routine.
	(Is_Ghost_Pragma): Removed.
	(Is_Ignored_Ghost_Pragma): New routine.
	(Set_Is_Checked_Ghost_Pragma): New routine.
	(Set_Is_Ghost_Pragma): Removed.
	(Set_Is_Ignored_Ghost_Pragma): New routine.
	* sinfo.ads: Update the documentation on Ghost mode and
	Ghost regions.	New attributes Is_Checked_Ghost_Pragma
	and Is_Ignored_Ghost_Pragma along with usages in nodes.
	Remove attribute Is_Ghost_Pragma along with usages in nodes.
	(Is_Checked_Ghost_Pragma): New routine along with pragma Inline.
	(Is_Ghost_Pragma): Removed along with pragma Inline.
	(Is_Ignored_Ghost_Pragma): New routine along with pragma Inline.
	(Set_Is_Checked_Ghost_Pragma): New routine along with pragma Inline.
	(Set_Is_Ghost_Pragma): Removed along with pragma Inline.
	(Set_Is_Ignored_Ghost_Pragma): New routine along with pragma Inline.

From-SVN: r244395

1 files changed, 29 insertions, 113 deletions

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ec47142..99d8b58 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2824,13 +2824,6 @@ package body Sem_Ch3 is
       if not Analyzed (T) then
          Set_Analyzed (T);
 
-         --  A type declared within a Ghost region is automatically Ghost
-         --  (SPARK RM 6.9(2)).
-
-         if Ghost_Mode > None then
-            Set_Is_Ghost_Entity (T);
-         end if;
-
          case Nkind (Def) is
             when N_Access_To_Subprogram_Definition =>
                Access_Subprogram_Declaration (T, Def);
@@ -3072,13 +3065,6 @@ package body Sem_Ch3 is
       Set_Is_First_Subtype (T, True);
       Set_Etype (T, T);
 
-      --  An incomplete type declared within a Ghost region is automatically
-      --  Ghost (SPARK RM 6.9(2)).
-
-      if Ghost_Mode > None then
-         Set_Is_Ghost_Entity (T);
-      end if;
-
       --  Ada 2005 (AI-326): Minimum decoration to give support to tagged
       --  incomplete types.
 
@@ -3186,13 +3172,6 @@ package body Sem_Ch3 is
       Generate_Definition (Id);
       Enter_Name (Id);
 
-      --  A number declared within a Ghost region is automatically Ghost
-      --  (SPARK RM 6.9(2)).
-
-      if Ghost_Mode > None then
-         Set_Is_Ghost_Entity (Id);
-      end if;
-
       --  This is an optimization of a common case of an integer literal
 
       if Nkind (E) = N_Integer_Literal then
@@ -3435,8 +3414,9 @@ package body Sem_Ch3 is
 
       --  Local variables
 
-      Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode;
-      Related_Id      : Entity_Id;
+      Mode       : Ghost_Mode_Type;
+      Mode_Set   : Boolean := False;
+      Related_Id : Entity_Id;
 
    --  Start of processing for Analyze_Object_Declaration
 
@@ -3501,14 +3481,14 @@ package body Sem_Ch3 is
          end if;
       end if;
 
-      --  The object declaration is Ghost when it is subject to pragma Ghost or
-      --  completes a deferred Ghost constant. Set the mode now to ensure that
-      --  any nodes generated during analysis and expansion are properly marked
-      --  as Ghost.
+      if Present (Prev_Entity) then
+
+         --  The object declaration is Ghost when it completes a deferred Ghost
+         --  constant.
 
-      Set_Ghost_Mode (N, Prev_Entity);
+         Mark_And_Set_Ghost_Completion (N, Prev_Entity, Mode);
+         Mode_Set := True;
 
-      if Present (Prev_Entity) then
          Constant_Redeclaration (Id, N, T);
 
          Generate_Reference (Prev_Entity, Id, 'c');
@@ -3802,8 +3782,7 @@ package body Sem_Ch3 is
            and then Analyzed (N)
            and then No (Expression (N))
          then
-            Ghost_Mode := Save_Ghost_Mode;
-            return;
+            goto Leave;
          end if;
 
          --  If E is null and has been replaced by an N_Raise_Constraint_Error
@@ -4061,23 +4040,6 @@ package body Sem_Ch3 is
                   Set_Ekind (Id, E_Variable);
                end if;
 
-               --  An object declared within a Ghost region is automatically
-               --  Ghost (SPARK RM 6.9(2)).
-
-               if Ghost_Mode > None then
-                  Set_Is_Ghost_Entity (Id);
-
-                  --  The Ghost policy in effect at the point of declaration
-                  --  and at the point of completion must match
-                  --  (SPARK RM 6.9(14)).
-
-                  if Present (Prev_Entity)
-                    and then Is_Ghost_Entity (Prev_Entity)
-                  then
-                     Check_Ghost_Completion (Prev_Entity, Id);
-                  end if;
-               end if;
-
                Rewrite (N,
                  Make_Object_Renaming_Declaration (Loc,
                    Defining_Identifier => Id,
@@ -4087,9 +4049,7 @@ package body Sem_Ch3 is
                Set_Renamed_Object (Id, E);
                Freeze_Before (N, T);
                Set_Is_Frozen (Id);
-
-               Ghost_Mode := Save_Ghost_Mode;
-               return;
+               goto Leave;
 
             else
                --  Ensure that the generated subtype has a unique external name
@@ -4263,22 +4223,6 @@ package body Sem_Ch3 is
       Init_Esize                   (Id);
       Set_Optimize_Alignment_Flags (Id);
 
-      --  An object declared within a Ghost region is automatically Ghost
-      --  (SPARK RM 6.9(2)).
-
-      if Ghost_Mode > None
-        or else (Present (Prev_Entity) and then Is_Ghost_Entity (Prev_Entity))
-      then
-         Set_Is_Ghost_Entity (Id);
-
-         --  The Ghost policy in effect at the point of declaration and at the
-         --  point of completion must match (SPARK RM 6.9(14)).
-
-         if Present (Prev_Entity) and then Is_Ghost_Entity (Prev_Entity) then
-            Check_Ghost_Completion (Prev_Entity, Id);
-         end if;
-      end if;
-
       --  Deal with aliased case
 
       if Aliased_Present (N) then
@@ -4481,7 +4425,9 @@ package body Sem_Ch3 is
          Check_No_Hidden_State (Id);
       end if;
 
-      Ghost_Mode := Save_Ghost_Mode;
+      if Mode_Set then
+         Restore_Ghost_Mode (Mode);
+      end if;
    end Analyze_Object_Declaration;
 
    ---------------------------
@@ -5501,13 +5447,13 @@ package body Sem_Ch3 is
    procedure Array_Type_Declaration (T : in out Entity_Id; Def : Node_Id) is
       Component_Def : constant Node_Id := Component_Definition (Def);
       Component_Typ : constant Node_Id := Subtype_Indication (Component_Def);
+      P             : constant Node_Id := Parent (Def);
       Element_Type  : Entity_Id;
       Implicit_Base : Entity_Id;
       Index         : Node_Id;
-      Related_Id    : Entity_Id := Empty;
       Nb_Index      : Nat;
-      P             : constant Node_Id := Parent (Def);
       Priv          : Entity_Id;
+      Related_Id    : Entity_Id := Empty;
 
    begin
       if Nkind (Def) = N_Constrained_Array_Definition then
@@ -5563,8 +5509,8 @@ package body Sem_Ch3 is
          then
             declare
                Loc   : constant Source_Ptr := Sloc (Def);
-               New_E : Entity_Id;
                Decl  : Entity_Id;
+               New_E : Entity_Id;
 
             begin
                New_E := Make_Temporary (Loc, 'T');
@@ -5705,12 +5651,6 @@ package body Sem_Ch3 is
 
          Propagate_Concurrent_Flags (Implicit_Base, Element_Type);
 
-         --  Inherit the "ghostness" from the constrained array type
-
-         if Ghost_Mode > None or else Is_Ghost_Entity (T) then
-            Set_Is_Ghost_Entity (Implicit_Base);
-         end if;
-
       --  Unconstrained array case
 
       else
@@ -6188,12 +6128,6 @@ package body Sem_Ch3 is
          Copy_Array_Base_Type_Attributes (Implicit_Base, Parent_Base);
 
          Set_Has_Delayed_Freeze (Implicit_Base, True);
-
-         --  Inherit the "ghostness" from the parent base type
-
-         if Ghost_Mode > None or else Is_Ghost_Entity (Parent_Base) then
-            Set_Is_Ghost_Entity (Implicit_Base);
-         end if;
       end Make_Implicit_Base;
 
    --  Start of processing for Build_Derived_Array_Type
@@ -9132,7 +9066,7 @@ package body Sem_Ch3 is
       --  (anonymous) base type.
 
       if Has_Predicates (Parent_Type)
-        or else  Has_Predicates (First_Subtype (Parent_Type))
+        or else Has_Predicates (First_Subtype (Parent_Type))
       then
          Set_Has_Predicates (Derived_Type);
       end if;
@@ -9148,8 +9082,9 @@ package body Sem_Ch3 is
          Set_May_Inherit_Delayed_Rep_Aspects (Derived_Type);
       end if;
 
-      --  Propagate the attributes related to pragma Ghost from the parent type
-      --  to the derived type or type extension (SPARK RM 6.9(9)).
+      --  A derived type becomes Ghost when its parent type is also Ghost
+      --  (SPARK RM 6.9(9)). Note that the Ghost-related attributes are not
+      --  directly inherited because the Ghost policy in effect may differ.
 
       if Is_Ghost_Entity (Parent_Type) then
          Set_Is_Ghost_Entity (Derived_Type);
@@ -14936,12 +14871,6 @@ package body Sem_Ch3 is
          Set_Alias (New_Subp, Actual_Subp);
       end if;
 
-      --  Inherit the "ghostness" from the parent subprogram
-
-      if Is_Ghost_Entity (Alias (New_Subp)) then
-         Set_Is_Ghost_Entity (New_Subp);
-      end if;
-
       --  Derived subprograms of a tagged type must inherit the convention
       --  of the parent subprogram (a requirement of AI-117). Derived
       --  subprograms of untagged types simply get convention Ada by default.
@@ -18346,12 +18275,6 @@ package body Sem_Ch3 is
       --  The class-wide type of a class-wide type is itself (RM 3.9(14))
 
       Set_Class_Wide_Type (CW_Type, CW_Type);
-
-      --  Inherit the "ghostness" from the root tagged type
-
-      if Ghost_Mode > None or else Is_Ghost_Entity (T) then
-         Set_Is_Ghost_Entity (CW_Type);
-      end if;
    end Make_Class_Wide_Type;
 
    ----------------
@@ -19584,11 +19507,14 @@ package body Sem_Ch3 is
 
       Full_Indic  : Node_Id;
       Full_Parent : Entity_Id;
+      Mode        : Ghost_Mode_Type;
       Priv_Parent : Entity_Id;
 
    --  Start of processing for Process_Full_View
 
    begin
+      Mark_And_Set_Ghost_Completion (N, Priv_T, Mode);
+
       --  First some sanity checks that must be done after semantic
       --  decoration of the full view and thus cannot be placed with other
       --  similar checks in Find_Type_Name
@@ -19701,7 +19627,7 @@ package body Sem_Ch3 is
          --  error situation [7.3(8)].
 
          if Priv_Parent = Any_Type or else Full_Parent = Any_Type then
-            return;
+            goto Leave;
 
          --  Ada 2005 (AI-251): Interfaces in the full type can be given in
          --  any order. Therefore we don't have to check that its parent must
@@ -20053,7 +19979,7 @@ package body Sem_Ch3 is
                         Next_Elmt (Prim_Elmt);
                      end loop;
 
-                     return;
+                     goto Leave;
                   end;
 
                --  For non-concurrent types, transfer explicit primitives, but
@@ -20190,19 +20116,6 @@ package body Sem_Ch3 is
          Set_Has_Specified_Stream_Output (Full_T);
       end if;
 
-      if Is_Ghost_Entity (Priv_T) then
-
-         --  The Ghost policy in effect at the point of declaration and at the
-         --  point of completion must match (SPARK RM 6.9(14)).
-
-         Check_Ghost_Completion (Priv_T, Full_T);
-
-         --  Propagate the attributes related to pragma Ghost from the private
-         --  to the full view.
-
-         Mark_Full_View_As_Ghost (Priv_T, Full_T);
-      end if;
-
       --  Propagate Default_Initial_Condition-related attributes from the
       --  partial view to the full view and its base type.
 
@@ -20251,6 +20164,9 @@ package body Sem_Ch3 is
             Set_Predicate_Function (Full_T, Predicate_Function (Priv_T));
          end if;
       end if;
+
+   <<Leave>>
+      Restore_Ghost_Mode (Mode);
    end Process_Full_View;
 
    -----------------------------------