2014-08-04 Robert Dewar <dewar@adacore.com>

	* prj-strt.adb, prj-strt.ads, sem_attr.adb: Minor reformatting.

2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb Add an entry in table Canonical_Aspect for
	Default_Initial_Condition.
	* aspects.ads Add an entry in tables Aspect_Id, Aspect_Argument,
	Aspect_Names and Aspect_Delay for Default_Initial_Condition.
	* einfo.adb Flag3 is now Has_Default_Init_Cond. Flag132
	is now Is_Default_Init_Cond_ Procedure. Flag133 is now
	Has_Inherited_Default_Init_Cond.
	(Default_Init_Cond_Procedure): New routine.
	(Has_Default_Init_Cond): New routine.
	(Has_Inherited_Default_Init_Cond): New routine.
	(Is_Default_Init_Cond_Procedure): New routine.
	(Set_Default_Init_Cond_Procedure): New routine.
	(Set_Has_Default_Init_Cond): New routine.
	(Set_Has_Inherited_Default_Init_Cond): New routine.
	(Set_Is_Default_Init_Cond_Procedure): New routine.
	(Write_Entity_Flags): Output all the new flags.
	* einfo.ads New attributes Default_Init_Cond_Procedure,
	Has_Inherited_Default_Init_Cond and Is_Default_Init_Cond_Procedure
	along with usage in nodes.
	(Default_Init_Cond_Procedure): New routine.
	(Has_Default_Init_Cond): New routine and pragma Inline.
	(Has_Inherited_Default_Init_Cond): New routine and
	pragma Inline.
	(Is_Default_Init_Cond_Procedure): New routine and
	pragma Inline.
	(Set_Default_Init_Cond_Procedure): New routine.
	(Set_Has_Default_Init_Cond): New routine and pragma Inline.
	(Set_Has_Inherited_Default_Init_Cond): New routine and pragma Inline.
	(Set_Is_Default_Init_Cond_Procedure): New routine and pragma Inline.
	* exp_ch3.adb (Expand_N_Object_Declaration): New constant
	Next_N. Generate a call to the default initial condition procedure
	if the object's type is subject to the pragma.	(Freeze_Type):
	Generate the body of the default initial condition procedure or
	inherit the spec from a parent type.
	* exp_ch7.adb Add with and use clause for Exp_Prag.
	(Expand_Pragma_Initial_Condition): Removed.
	* exp_prag.ads, exp_prag.adb (Expand_Pragma_Initial_Condition): New
	routine.
	* par-prag.adb (Prag): Pragma Default_Initial_Condition does
	not need special treatment by the parser.
	* sem_ch3.adb (Build_Derived_Record_Type): Propagate the
	attributes related to pragma Default_Initial_Condition to the
	derived type.
	(Process_Full_View): Propagate the attributes
	related to pragma Default_Initial_Condition to the full view.
	* sem_ch7.adb (Analyze_Package_Specification): Build the
	declaration of the default initial condition procedure for all
	types that qualify or inherit the one from the parent type.
	* sem_ch13.adb (Analyze_Aspect_Specifications):
	Add processing for aspect Default_Initial_Condition.
	(Check_Aspect_At_Freeze_Point): Aspect
	Default_Initial_Condition does not require delayed analysis.
	(Replace_Type_References_Generic): Moved to spec.
	* sem_ch13.ads (Replace_Type_References_Generic): Moved from body.
	* sem_prag.adb Add an entry in table Sif_Glags for
	Default_Initial_Condition.
	(Analyze_Pragma): Pragma
	Default_Initial_Condition is now part of assertion
	policy. Add processing for pragma Default_Initial_Condition.
	(Is_Valid_Assertion_Kind): Pragma Default_Initial_Condition is
	now recognized as a proper assertion policy.
	* sem_util.ads, sem_util.adb (Build_Default_Init_Cond_Call): New
	routine.
	(Build_Default_Init_Cond_Procedure_Body): New routine.
	(Build_Default_Init_Cond_Procedure_Declaration): New routine.
	(Inherit_Default_Init_Cond_Procedure): New routine.
	* snames.ads-tmpl Add new predefined name and pragma id for
	Default_Initial_Condition.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@213552 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 28 insertions, 5 deletions

diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index cdb84dc97ca..025b0cfbbe8 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -211,6 +211,25 @@ package Sem_Util is
    --  Determine whether a selected component has a type that depends on
    --  discriminants, and build actual subtype for it if so.
 
+   function Build_Default_Init_Cond_Call
+     (Loc    : Source_Ptr;
+      Obj_Id : Entity_Id;
+      Typ    : Entity_Id) return Node_Id;
+   --  Build a call to the default initial condition procedure of type Typ with
+   --  Obj_Id as the actual parameter.
+
+   procedure Build_Default_Init_Cond_Procedure_Body (Typ : Entity_Id);
+   --  If private type Typ is subject to pragma Default_Initial_Condition,
+   --  build the body of the procedure which verifies the assumption of the
+   --  pragma at runtime. The generated body is added to the freeze actions
+   --  of the type.
+
+   procedure Build_Default_Init_Cond_Procedure_Declaration (Typ : Entity_Id);
+   --  If private type Typ is subject to pragma Default_Initial_Condition,
+   --  build the declaration of the procedure which verifies the assumption
+   --  of the pragma at runtime. The declaration is inserted after the related
+   --  pragma.
+
    function Build_Default_Subtype
      (T : Entity_Id;
       N : Node_Id) return Entity_Id;
@@ -1065,6 +1084,10 @@ package Sem_Util is
    --  the same type. Note that Typ may not have a partial view to begin with,
    --  in that case the function returns Empty.
 
+   procedure Inherit_Default_Init_Cond_Procedure (Typ : Entity_Id);
+   --  Inherit the default initial condition procedure from the parent type of
+   --  derived type Typ.
+
    procedure Insert_Explicit_Dereference (N : Node_Id);
    --  In a context that requires a composite or subprogram type and where a
    --  prefix is an access type, rewrite the access type node N (which is the
@@ -1596,17 +1619,17 @@ package Sem_Util is
    --  (e.g. target of assignment, or out parameter), and to False if the
    --  modification is only potential (e.g. address of entity taken).
 
+   function Object_Access_Level (Obj : Node_Id) return Uint;
+   --  Return the accessibility level of the view of the object Obj. For
+   --  convenience, qualified expressions applied to object names are also
+   --  allowed as actuals for this function.
+
    function Original_Corresponding_Operation (S : Entity_Id) return Entity_Id;
    --  [Ada 2012: AI05-0125-1]: If S is an inherited dispatching primitive S2,
    --  or overrides an inherited dispatching primitive S2, the original
    --  corresponding operation of S is the original corresponding operation of
    --  S2. Otherwise, it is S itself.
 
-   function Object_Access_Level (Obj : Node_Id) return Uint;
-   --  Return the accessibility level of the view of the object Obj. For
-   --  convenience, qualified expressions applied to object names are also
-   --  allowed as actuals for this function.
-
    function Original_Aspect_Name (N : Node_Id) return Name_Id;
    --  N is a pragma node or aspect specification node. This function returns
    --  the name of the pragma or aspect in original source form, taking into