2011-08-29 Matthew Heaney <heaney@adacore.com>

	* a-comutr.adb, a-cimutr.adb, a-cbmutr.adb (Splice_Subtree): Only check
	for sibling when common parent.

2011-08-29  Thomas Quinot  <quinot@adacore.com>

	* get_scos.adb: Literals of Pragma_Id are pragma names prefixed with
	"pragma_".

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb (Analyze_Subprogram_Body_Helper): Enable freeze actions
	for the return type when in ASIS mode.

2011-08-29  Vincent Celier  <celier@adacore.com>

	* make.adb (Gnatmake): Get the default search dirs, then the target
	parameters after getting the Builder switches, as the Builder switches
	may include --RTS= and that could change the default search dirs.

2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch7.adb (Make_Adjust_Call): Rewrite to mimic the structure of
	Make_Final_Call. Move the processing for class-wide types before the
	processing for derivations from [Limited_]Controlled.
	(Make_Final_Call): Move the processing for class-wide types before the
	processing for derivations from [Limited_]Controlled.
	* s-stposu.adb (Allocate_Any_Controlled): Correct the membership check.
	Add code to account for alignments larger than the list header. Add a
	comment illustrating the structure of the allocated object + padding +
	header.
	(Deallocate_Any_Controlled): Add code to account for alignments larger
	than the list header.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* sinfo.ads, sinfo.adb: New node kind
	N_Formal_Incomplete_Type_Definition, related flags.
	par-ch12.adb (P_Formal_Type_Declaration, G_Formal_Type_Definition):
	Parse formal incomplete types.
	* sem.adb (Analyze): Formal_Incomplete_Type_Definitions are handled in
	sem_ch12.
	* sem_ch7.adb (Analyze_Package_Specification, Unit_Requires_Body):
	Formal incomplete types do not need completion.
	* sem_ch12.adb (Analyze_Formal_Incomplete_Type,
	Validate_Incomplete_Type_Instance): New procedures to handle formal
	incomplete types.
	* freeze.adb (Freeze_Entity): Do not freeze the subtype of an actual
	that corresponds to a formal incomplete type.
	* sprint.adb: Handle formal incomplete type declarations.
	* exp_util.adb (Insert_Actions): An incomplete_type_definition is not
	an insertion point.



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

1 files changed, 60 insertions, 17 deletions

diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb
index a4c0bb6c8ea..0e67bba3402 100644
--- a/gcc/ada/s-stposu.adb
+++ b/gcc/ada/s-stposu.adb
@@ -91,11 +91,8 @@ package body System.Storage_Pools.Subpools is
       Alignment       : System.Storage_Elements.Storage_Count;
       Is_Controlled   : Boolean := True)
    is
-      --  ??? This membership test gives the wrong result when Pool has
-      --  subpools.
-
       Is_Subpool_Allocation : constant Boolean :=
-                                Pool in Root_Storage_Pool_With_Subpools;
+                                Pool in Root_Storage_Pool_With_Subpools'Class;
 
       Master  : Finalization_Master_Ptr := null;
       N_Addr  : Address;
@@ -103,6 +100,10 @@ package body System.Storage_Pools.Subpools is
       N_Size  : Storage_Count;
       Subpool : Subpool_Handle := null;
 
+      Header_And_Padding : Storage_Offset;
+      --  This offset includes the size of a FM_Node plus any additional
+      --  padding due to a larger alignment.
+
    begin
       --  Step 1: Pool-related runtime checks
 
@@ -165,7 +166,7 @@ package body System.Storage_Pools.Subpools is
          Master := Context_Master;
       end if;
 
-      --  Step 2: Master-related runtime checks
+      --  Step 2: Master-related runtime checks and size calculations
 
       --  Allocation of a descendant from [Limited_]Controlled, a class-wide
       --  object or a record with controlled components.
@@ -179,9 +180,17 @@ package body System.Storage_Pools.Subpools is
             raise Program_Error with "allocation after finalization started";
          end if;
 
-         --  The size must acount for the hidden header preceding the object
+         --  The size must acount for the hidden header preceding the object.
+         --  Account for possible padding space before the header due to a
+         --  larger alignment.
+
+         if Alignment > Header_Size then
+            Header_And_Padding := Alignment;
+         else
+            Header_And_Padding := Header_Size;
+         end if;
 
-         N_Size := Storage_Size + Header_Size;
+         N_Size := Storage_Size + Header_And_Padding;
 
       --  Non-controlled allocation
 
@@ -211,9 +220,23 @@ package body System.Storage_Pools.Subpools is
       if Is_Controlled then
 
          --  Map the allocated memory into a FM_Node record. This converts the
-         --  top of the allocated bits into a list header.
-
-         N_Ptr := Address_To_FM_Node_Ptr (N_Addr);
+         --  top of the allocated bits into a list header. If there is padding
+         --  due to larger alignment, the header is placed right next to the
+         --  object:
+
+         --    N_Addr  N_Ptr
+         --    |       |
+         --    V       V
+         --    +-------+---------------+----------------------+
+         --    |Padding|    Header     |        Object        |
+         --    +-------+---------------+----------------------+
+         --    ^       ^               ^
+         --    |       +- Header_Size -+
+         --    |                       |
+         --    +- Header_And_Padding --+
+
+         N_Ptr :=
+           Address_To_FM_Node_Ptr (N_Addr + Header_And_Padding - Header_Size);
 
          --  Check whether primitive Finalize_Address is available. If it is
          --  not, then either the expansion of the designated type failed or
@@ -233,7 +256,7 @@ package body System.Storage_Pools.Subpools is
          --  Move the address from the hidden list header to the start of the
          --  object. This operation effectively hides the list header.
 
-         Addr := N_Addr + Header_Offset;
+         Addr := N_Addr + Header_And_Padding;
       else
          Addr := N_Addr;
       end if;
@@ -273,19 +296,34 @@ package body System.Storage_Pools.Subpools is
       N_Ptr  : FM_Node_Ptr;
       N_Size : Storage_Count;
 
+      Header_And_Padding : Storage_Offset;
+      --  This offset includes the size of a FM_Node plus any additional
+      --  padding due to a larger alignment.
+
    begin
       --  Step 1: Detachment
 
       if Is_Controlled then
+         if Alignment > Header_Size then
+            Header_And_Padding := Alignment;
+         else
+            Header_And_Padding := Header_Size;
+         end if;
 
-         --  Move the address from the object to the beginning of the list
-         --  header.
-
-         N_Addr := Addr - Header_Offset;
+         --    N_Addr  N_Ptr           Addr (from input)
+         --    |       |               |
+         --    V       V               V
+         --    +-------+---------------+----------------------+
+         --    |Padding|    Header     |        Object        |
+         --    +-------+---------------+----------------------+
+         --    ^       ^               ^
+         --    |       +- Header_Size -+
+         --    |                       |
+         --    +- Header_And_Padding --+
 
          --  Convert the bits preceding the object into a list header
 
-         N_Ptr := Address_To_FM_Node_Ptr (N_Addr);
+         N_Ptr := Address_To_FM_Node_Ptr (Addr - Header_Size);
 
          --  Detach the object from the related finalization master. This
          --  action does not need to know the prior context used during
@@ -293,10 +331,15 @@ package body System.Storage_Pools.Subpools is
 
          Detach (N_Ptr);
 
+         --  Move the address from the object to the beginning of the list
+         --  header.
+
+         N_Addr := Addr - Header_And_Padding;
+
          --  The size of the deallocated object must include the size of the
          --  hidden list header.
 
-         N_Size := Storage_Size + Header_Size;
+         N_Size := Storage_Size + Header_And_Padding;
       else
          N_Addr := Addr;
          N_Size := Storage_Size;