[multiple changes]

2014-08-04  Olivier Hainque  <hainque@adacore.com>

	* a-comutr.ads: Set Root_Node_Type'Alignment to
	Standard'Maximum_Alignment, so that it is at least as large as
	the max default for Tree_Node_Type'Alignment.

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

	* exp_ch3.adb (Freeze_Type): Remove the generation and inheritance
	of the default initial condition procedure [body].
	* sem_ch3.adb (Analyze_Declarations): Create the bodies of
	all default initial condition procedures at the end of private
	declaration analysis.
	* sem_util.adb (Build_Default_Init_Cond_Procedure_Bodies): New
	routine.
	(Build_Default_Init_Cond_Procedure_Body): Merged in the
	processing of routine Build_Default_Init_Cond_Procedure_Bodies.
	* sem_util.ads (Build_Default_Init_Cond_Procedure_Bodies):
	New routine.
	(Build_Default_Init_Cond_Procedure_Body): Removed.

2014-08-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_elab.adb (Check_Elab_Call): Do not check a call to a
	postcondtion.
	* exp_ch6.adb (Expand_Call): Clarify handling of inserted
	postcondition call.

From-SVN: r213580

gcc/ada/ChangeLog

+2014-08-04  Olivier Hainque  <hainque@adacore.com>
+
+	* a-comutr.ads: Set Root_Node_Type'Alignment to
+	Standard'Maximum_Alignment, so that it is at least as large as
+	the max default for Tree_Node_Type'Alignment.
+
+2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch3.adb (Freeze_Type): Remove the generation and inheritance
+	of the default initial condition procedure [body].
+	* sem_ch3.adb (Analyze_Declarations): Create the bodies of
+	all default initial condition procedures at the end of private
+	declaration analysis.
+	* sem_util.adb (Build_Default_Init_Cond_Procedure_Bodies): New
+	routine.
+	(Build_Default_Init_Cond_Procedure_Body): Merged in the
+	processing of routine Build_Default_Init_Cond_Procedure_Bodies.
+	* sem_util.ads (Build_Default_Init_Cond_Procedure_Bodies):
+	New routine.
+	(Build_Default_Init_Cond_Procedure_Body): Removed.
+
+2014-08-04  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_elab.adb (Check_Elab_Call): Do not check a call to a
+	postcondtion.
+	* exp_ch6.adb (Expand_Call): Clarify handling of inserted
+	postcondition call.
+
 2014-08-04  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Analyze_Pragma): Ensure that an

gcc/ada/a-comutr.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2012, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -308,17 +308,16 @@ package Ada.Containers.Multiway_Trees is
       Process : not null access procedure (Position : Cursor));
 
 private
-
    --  A node of this multiway tree comprises an element and a list of children
    --  (that are themselves trees). The root node is distinguished because it
    --  contains only children: it does not have an element itself.
-   --
-   --  This design feature puts two design goals in tension:
+
+   --  This design feature puts two design goals in tension with one another:
    --   (1) treat the root node the same as any other node
    --   (2) not declare any objects of type Element_Type unnecessarily
-   --
-   --  To satisfy (1), we could simply declare the Root node of the tree using
-   --  the normal Tree_Node_Type, but that would mean that (2) is not
+
+   --  To satisfy (1), we could simply declare the Root node of the tree
+   --  using the normal Tree_Node_Type, but that would mean that (2) is not
    --  satisfied. To resolve the tension (in favor of (2)), we declare the
    --  component Root as having a different node type, without an Element
    --  component (thus satisfying goal (2)) but otherwise identical to a normal
@@ -327,11 +326,11 @@ private
    --  normal, non-root node (thus satisfying goal (1)). We make an explicit
    --  check for Root when there is any attempt to manipulate the Element
    --  component of the node (a check required by the RM anyway).
-   --
+
    --  In order to be explicit about node (and pointer) representation, we
-   --  specify that the respective node types have convention C, to ensure that
-   --  the layout of the components of the node records is the same, thus
-   --  guaranteeing that (unchecked) conversions between access types
+   --  specify that the respective node types have convention C, to ensure
+   --  that the layout of the components of the node records is the same,
+   --  thus guaranteeing that (unchecked) conversions between access types
    --  designating each kind of node type is a meaningful conversion.
 
    type Tree_Node_Type;
@@ -366,6 +365,11 @@ private
    end record;
    pragma Convention (C, Root_Node_Type);
 
+   for Root_Node_Type'Alignment use Standard'Maximum_Alignment;
+   --  The alignment has to be large enough to allow Root_Node to Tree_Node
+   --  access value conversions, and Tree_Node_Type's alignment may be bumped
+   --  up by the Element component.
+
    use Ada.Finalization;
 
    --  The Count component of type Tree represents the number of nodes that

gcc/ada/exp_ch3.adb

@@ -7394,20 +7394,6 @@ package body Exp_Ch3 is
          end if;
       end if;
 
-      --  If the type is subject to pragma Default_Initial_Condition, generate
-      --  the body of the procedure which verifies the assertion of the pragma
-      --  at runtime.
-
-      if Has_Default_Init_Cond (Def_Id) then
-         Build_Default_Init_Cond_Procedure_Body (Def_Id);
-
-      --  A derived type inherits the default initial condition procedure from
-      --  its parent type.
-
-      elsif Has_Inherited_Default_Init_Cond (Def_Id) then
-         Inherit_Default_Init_Cond_Procedure (Def_Id);
-      end if;
-
       --  Freeze processing for record types
 
       if Is_Record_Type (Def_Id) then

gcc/ada/exp_ch6.adb

@@ -5209,6 +5209,13 @@ package body Exp_Ch6 is
                --  Analyze call, but something goes wrong in some weird cases
                --  and it is not worth worrying about ???
 
+               --  The return statement is handled properly, and the call to
+               --  the postcondition, inserted below, does not require
+               --  information from the body either. However, that call is
+               --  analyzed in the enclosing scope, and an elaboration check
+               --  might improperly be added to it.  A guard in sem_elab is
+               --  needed to prevent that spurious check, see Check_Elab_Call.
+
                Append_To (S, Rtn);
                Set_Analyzed (Rtn);
 

gcc/ada/sem_ch3.adb

@@ -2388,10 +2388,13 @@ package body Sem_Ch3 is
             --  When a package has private declarations, its contract must be
             --  analyzed at the end of the said declarations. This way both the
             --  analysis and freeze actions are properly synchronized in case
-            --  of private type use within the contract.
+            --  of private type use within the contract. Build the bodies of
+            --  the default initial condition procedures for all types subject
+            --  to pragma Default_Initial_Condition.
 
             if L = Private_Declarations (Context) then
                Analyze_Package_Contract (Defining_Entity (Context));
+               Build_Default_Init_Cond_Procedure_Bodies (L);
 
             --  Otherwise the contract is analyzed at the end of the visible
             --  declarations.

gcc/ada/sem_elab.adb

@@ -1218,6 +1218,17 @@ package body Sem_Elab is
          return;
       end if;
 
+      --  Nothing to do if this is a call to a postcondition, which is always
+      --  within a subprogram body, even though the current scope may be the
+      --  enclosing scope of the subprogram.
+
+      if Nkind (N) = N_Procedure_Call_Statement
+        and then Is_Entity_Name (Name (N))
+        and then Chars (Entity (Name (N))) = Name_uPostconditions
+      then
+         return;
+      end if;
+
       --  Here we have a call at elaboration time which must be checked
 
       if Debug_Flag_LL then

gcc/ada/sem_util.adb

@@ -1252,17 +1252,28 @@ package body Sem_Util is
               Expression   => New_Occurrence_Of (Obj_Id, Loc))));
    end Build_Default_Init_Cond_Call;
 
+   ----------------------------------------------
+   -- Build_Default_Init_Cond_Procedure_Bodies --
+   ----------------------------------------------
+
+   procedure Build_Default_Init_Cond_Procedure_Bodies (Priv_Decls : List_Id) is
+      procedure Build_Default_Init_Cond_Procedure_Body (Typ : Entity_Id);
+      --  If 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 after the type declaration.
+
       --------------------------------------------
       -- Build_Default_Init_Cond_Procedure_Body --
       --------------------------------------------
 
       procedure Build_Default_Init_Cond_Procedure_Body (Typ : Entity_Id) is
          Param_Id : Entity_Id;
-      --  The entity of the formal parameter of the default initial condition
-      --  procedure.
+         --  The entity of the sole formal parameter of the default initial
+         --  condition procedure.
 
          procedure Replace_Type_Reference (N : Node_Id);
-      --  Replace a single reference to type Typ with a reference to Param_Id
+         --  Replace a single reference to type Typ with a reference to formal
+         --  parameter Param_Id.
 
          ----------------------------
          -- Replace_Type_Reference --
@@ -1290,9 +1301,9 @@ package body Sem_Util is
       --  Start of processing for Build_Default_Init_Cond_Procedure
 
       begin
-      --  The procedure should be generated only for types subject to pragma
-      --  Default_Initial_Condition. Types that inherit the pragma do not get
-      --  this specialized procedure.
+         --  The procedure should be generated only for [sub]types subject to
+         --  pragma Default_Initial_Condition. Types that inherit the pragma do
+         --  not get this specialized procedure.
 
          pragma Assert (Has_Default_Init_Cond (Typ));
          pragma Assert (Present (Prag));
@@ -1306,11 +1317,13 @@ package body Sem_Util is
 
          Param_Id := First_Formal (Proc_Id);
 
-      --  The pragma has an argument. Note that the argument is analyzed after
-      --  all references to the current instance of the type are replaced.
+         --  The pragma has an argument. Note that the argument is analyzed
+         --  after all references to the current instance of the type are
+         --  replaced.
 
          if Present (Pragma_Argument_Associations (Prag)) then
-         Expr := Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag)));
+            Expr :=
+              Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag)));
 
             if Nkind (Expr) = N_Null then
                Stmt := Make_Null_Statement (Loc);
@@ -1334,7 +1347,8 @@ package body Sem_Util is
                    Pragma_Argument_Associations => New_List (
                      Make_Pragma_Argument_Association (Loc,
                        Expression =>
-                      Make_Identifier (Loc, Name_Default_Initial_Condition)),
+                         Make_Identifier (Loc,
+                           Chars => Name_Default_Initial_Condition)),
                      Make_Pragma_Argument_Association (Loc,
                        Expression => Expr)));
             end if;
@@ -1361,15 +1375,55 @@ package body Sem_Util is
                  Statements => New_List (Stmt)));
 
          --  Link the spec and body of the default initial condition procedure
-      --  to prevent the generation of a duplicate body in case there is an
-      --  attempt to freeze the related type again.
+         --  to prevent the generation of a duplicate body.
 
          Set_Corresponding_Body (Spec_Decl, Defining_Entity (Body_Decl));
          Set_Corresponding_Spec (Body_Decl, Proc_Id);
 
-      Append_Freeze_Action (Typ, Body_Decl);
+         Insert_After_And_Analyze (Declaration_Node (Typ), Body_Decl);
       end Build_Default_Init_Cond_Procedure_Body;
 
+      --  Local variables
+
+      Decl : Node_Id;
+      Typ  : Entity_Id;
+
+   --  Start of processing for Build_Default_Init_Cond_Procedure_Bodies
+
+   begin
+      --  Inspect the private declarations looking for [sub]type declarations
+
+      Decl := First (Priv_Decls);
+      while Present (Decl) loop
+         if Nkind_In (Decl, N_Full_Type_Declaration,
+                            N_Subtype_Declaration)
+         then
+            Typ := Defining_Entity (Decl);
+
+            --  Guard against partially decorate types due to previous errors
+
+            if Is_Type (Typ) then
+
+               --  If the type is subject to pragma Default_Initial_Condition,
+               --  generate the body of the internal procedure which verifies
+               --  the assertion of the pragma at runtime.
+
+               if Has_Default_Init_Cond (Typ) then
+                  Build_Default_Init_Cond_Procedure_Body (Typ);
+
+               --  A derived type inherits the default initial condition
+               --  procedure from its parent type.
+
+               elsif Has_Inherited_Default_Init_Cond (Typ) then
+                  Inherit_Default_Init_Cond_Procedure (Typ);
+               end if;
+            end if;
+         end if;
+
+         Next (Decl);
+      end loop;
+   end Build_Default_Init_Cond_Procedure_Bodies;
+
    ---------------------------------------------------
    -- Build_Default_Init_Cond_Procedure_Declaration --
    ---------------------------------------------------

gcc/ada/sem_util.ads

@@ -218,11 +218,10 @@ package Sem_Util is
    --  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_Bodies (Priv_Decls : List_Id);
+   --  Inspect the contents of private declarations Priv_Decls and build the
+   --  bodies the default initial condition procedures for all types subject
+   --  to pragma Default_Initial_Condition.
 
    procedure Build_Default_Init_Cond_Procedure_Declaration (Typ : Entity_Id);
    --  If private type Typ is subject to pragma Default_Initial_Condition,