[multiple changes]

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.

From-SVN: r213552

1 files changed, 45 insertions, 34 deletions

diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 3ef5836..ca52755 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -182,17 +182,6 @@ package body Sem_Ch13 is
    --  renaming_as_body. For tagged types, the specification is one of the
    --  primitive specs.
 
-   generic
-      with procedure Replace_Type_Reference (N : Node_Id);
-   procedure Replace_Type_References_Generic (N : Node_Id; T : Entity_Id);
-   --  This is used to scan an expression for a predicate or invariant aspect
-   --  replacing occurrences of the name of the subtype to which the aspect
-   --  applies with appropriate references to the parameter of the predicate
-   --  function or invariant procedure. The procedure passed as a generic
-   --  parameter does the actual replacement of node N, which is either a
-   --  simple direct reference to T, or a selected component that represents
-   --  an appropriately qualified occurrence of T.
-
    procedure Resolve_Iterable_Operation
      (N      : Node_Id;
       Cursor : Entity_Id;
@@ -2221,6 +2210,26 @@ package body Sem_Ch13 is
                   goto Continue;
                end Abstract_State;
 
+               --  Aspect Default_Internal_Condition is never delayed because
+               --  it is equivalent to a source pragma which appears after the
+               --  related private type. To deal with forward references, the
+               --  generated pragma is stored in the rep chain of the related
+               --  private type as types do not carry contracts. The pragma is
+               --  wrapped inside of a procedure at the freeze point of the
+               --  private type's full view.
+
+               when Aspect_Default_Initial_Condition =>
+                  Make_Aitem_Pragma
+                    (Pragma_Argument_Associations => New_List (
+                       Make_Pragma_Argument_Association (Loc,
+                         Expression => Relocate_Node (Expr))),
+                     Pragma_Name                  =>
+                       Name_Default_Initial_Condition);
+
+                  Decorate (Aspect, Aitem);
+                  Insert_Pragma (Aitem);
+                  goto Continue;
+
                --  Depends
 
                --  Aspect Depends is never delayed because it is equivalent to
@@ -8737,25 +8746,26 @@ package body Sem_Ch13 is
 
          --  Here is the list of aspects that don't require delay analysis
 
-         when Aspect_Abstract_State       |
-              Aspect_Annotate             |
-              Aspect_Contract_Cases       |
-              Aspect_Dimension            |
-              Aspect_Dimension_System     |
-              Aspect_Implicit_Dereference |
-              Aspect_Initial_Condition    |
-              Aspect_Initializes          |
-              Aspect_Part_Of              |
-              Aspect_Post                 |
-              Aspect_Postcondition        |
-              Aspect_Pre                  |
-              Aspect_Precondition         |
-              Aspect_Refined_Depends      |
-              Aspect_Refined_Global       |
-              Aspect_Refined_Post         |
-              Aspect_Refined_State        |
-              Aspect_SPARK_Mode           |
-              Aspect_Test_Case            =>
+         when Aspect_Abstract_State            |
+              Aspect_Annotate                  |
+              Aspect_Contract_Cases            |
+              Aspect_Default_Initial_Condition |
+              Aspect_Dimension                 |
+              Aspect_Dimension_System          |
+              Aspect_Implicit_Dereference      |
+              Aspect_Initial_Condition         |
+              Aspect_Initializes               |
+              Aspect_Part_Of                   |
+              Aspect_Post                      |
+              Aspect_Postcondition             |
+              Aspect_Pre                       |
+              Aspect_Precondition              |
+              Aspect_Refined_Depends           |
+              Aspect_Refined_Global            |
+              Aspect_Refined_Post              |
+              Aspect_Refined_State             |
+              Aspect_SPARK_Mode                |
+              Aspect_Test_Case                 =>
             raise Program_Error;
 
       end case;
@@ -10555,9 +10565,10 @@ package body Sem_Ch13 is
         (Rep_Item : Node_Id) return Boolean
       is
       begin
-         return Nkind (Rep_Item) = N_Pragma
-           or else Present_In_Rep_Item
-                     (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item));
+         return
+           Nkind (Rep_Item) = N_Pragma
+             or else Present_In_Rep_Item
+                       (Entity (Rep_Item), Aspect_Rep_Item (Rep_Item));
       end Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item;
 
    --  Start of processing for Inherit_Aspects_At_Freeze_Point
@@ -11746,7 +11757,7 @@ package body Sem_Ch13 is
                end loop;
             end if;
 
-            --  Continue for any other node kind
+         --  Continue for any other node kind
 
          else
             return OK;