[multiple changes]

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.

From-SVN: r178184

18 files changed, 488 insertions, 165 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 90001ba..608b8c0 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,57 @@
+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.
+
 2011-08-29  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* a-fihema.ads, a-fihema.adb: Unit removed.
diff --git a/gcc/ada/a-cbmutr.adb b/gcc/ada/a-cbmutr.adb
index 738097f..da64261 100644
--- a/gcc/ada/a-cbmutr.adb
+++ b/gcc/ada/a-cbmutr.adb
@@ -2676,13 +2676,18 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       end if;
 
       if Target'Address = Source'Address then
-         if Before = No_Element then
-            if Target.Nodes (Position.Node).Next <= 0 then  -- last child
+         if Target.Nodes (Position.Node).Parent = Parent.Node then
+            if Before = No_Element then
+               if Target.Nodes (Position.Node).Next <= 0 then  -- last child
+                  return;
+               end if;
+
+            elsif Position.Node = Before.Node then
                return;
-            end if;
 
-         elsif Position.Node = Before.Node then
-            return;
+            elsif Target.Nodes (Position.Node).Next = Before.Node then
+               return;
+            end if;
          end if;
 
          if Target.Busy > 0 then
@@ -2769,13 +2774,18 @@ package body Ada.Containers.Bounded_Multiway_Trees is
          raise Constraint_Error with "Position cursor designates root";
       end if;
 
-      if Before = No_Element then
-         if Container.Nodes (Position.Node).Next <= 0 then  -- last child
+      if Container.Nodes (Position.Node).Parent = Parent.Node then
+         if Before = No_Element then
+            if Container.Nodes (Position.Node).Next <= 0 then  -- last child
+               return;
+            end if;
+
+         elsif Position.Node = Before.Node then
             return;
-         end if;
 
-      elsif Position.Node = Before.Node then
-         return;
+         elsif Container.Nodes (Position.Node).Next = Before.Node then
+            return;
+         end if;
       end if;
 
       if Container.Busy > 0 then
@@ -2809,6 +2819,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
       Target_Count   : Count_Type;
 
    begin
+      --  This is a utility operation to do the heavy lifting associated with
+      --  splicing a subtree from one tree to another. Note that "splicing"
+      --  is a bit of a misnomer here in the case of a bounded tree, because
+      --  the elements must be copied from the source to the target.
+
       if Target.Count > Target.Capacity - Source_Count then
          raise Capacity_Error  -- ???
            with "Source count exceeds available storage on Target";
@@ -2830,6 +2845,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
 
       pragma Assert (Target_Count = Source_Count);
 
+      --  Now link the newly-allocated subtree into the target.
+
       Insert_Subtree_Node
         (Container => Target,
          Subtree   => Target_Subtree,
@@ -2838,6 +2855,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
 
       Target.Count := Target.Count + Target_Count;
 
+      --  The manipulation of the Target container is complete. Now we remove
+      --  the subtree from the Source container.
+
+      Remove_Subtree (Source, Position);  -- unlink the subtree
+
       --  As with Copy_Subtree, operation Deallocate_Subtree returns a count of
       --  the number of nodes it deallocates, but it works by incrementing the
       --  value passed in. We must therefore initialize the count before
@@ -2845,7 +2867,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
 
       Source_Count := 0;
 
-      Deallocate_Children (Source, Position, Source_Count);
+      Deallocate_Subtree (Source, Position, Source_Count);
       pragma Assert (Source_Count = Target_Count);
 
       Source.Count := Source.Count - Source_Count;
diff --git a/gcc/ada/a-cimutr.adb b/gcc/ada/a-cimutr.adb
index 8f310a3..add7605 100644
--- a/gcc/ada/a-cimutr.adb
+++ b/gcc/ada/a-cimutr.adb
@@ -2101,10 +2101,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
       end if;
 
       if Target'Address = Source'Address then
-         if Position.Node = Before.Node
-           or else Position.Node.Next = Before.Node
-         then
-            return;
+         if Position.Node.Parent = Parent.Node then
+            if Position.Node = Before.Node then
+               return;
+            end if;
+
+            if Position.Node.Next = Before.Node then
+               return;
+            end if;
          end if;
 
          if Target.Busy > 0 then
@@ -2199,10 +2203,14 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
          raise Constraint_Error with "Position cursor designates root";
       end if;
 
-      if Position.Node = Before.Node
-        or else Position.Node.Next = Before.Node
-      then
-         return;
+      if Position.Node.Parent = Parent.Node then
+         if Position.Node = Before.Node then
+            return;
+         end if;
+
+         if Position.Node.Next = Before.Node then
+            return;
+         end if;
       end if;
 
       if Container.Busy > 0 then
diff --git a/gcc/ada/a-comutr.adb b/gcc/ada/a-comutr.adb
index f718eb8..b5132f9 100644
--- a/gcc/ada/a-comutr.adb
+++ b/gcc/ada/a-comutr.adb
@@ -2147,10 +2147,14 @@ package body Ada.Containers.Multiway_Trees is
       end if;
 
       if Target'Address = Source'Address then
-         if Position.Node = Before.Node
-           or else Position.Node.Next = Before.Node
-         then
-            return;
+         if Position.Node.Parent = Parent.Node then
+            if Position.Node = Before.Node then
+               return;
+            end if;
+
+            if Position.Node.Next = Before.Node then
+               return;
+            end if;
          end if;
 
          if Target.Busy > 0 then
@@ -2245,10 +2249,14 @@ package body Ada.Containers.Multiway_Trees is
          raise Constraint_Error with "Position cursor designates root";
       end if;
 
-      if Position.Node = Before.Node
-        or else Position.Node.Next = Before.Node
-      then
-         return;
+      if Position.Node.Parent = Parent.Node then
+         if Position.Node = Before.Node then
+            return;
+         end if;
+
+         if Position.Node.Next = Before.Node then
+            return;
+         end if;
       end if;
 
       if Container.Busy > 0 then
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index acd64ca..9ba5f6e 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4560,19 +4560,10 @@ package body Exp_Ch7 is
             Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
          end if;
 
-      --  For types that are both controlled and have controlled components,
-      --  generate a call to Deep_Adjust.
-
-      elsif Is_Controlled (Utyp)
-        and then Has_Controlled_Component (Utyp)
-      then
-         Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
-
-      --  For types that are not controlled themselves, but contain controlled
-      --  components or can be extended by types with controlled components,
-      --  create a call to Deep_Adjust.
+      --  Class-wide types, interfaces and types with controlled components
 
       elsif Is_Class_Wide_Type (Typ)
+        or else Is_Interface (Typ)
         or else Has_Controlled_Component (Utyp)
       then
          if Is_Tagged_Type (Utyp) then
@@ -4581,11 +4572,22 @@ package body Exp_Ch7 is
             Adj_Id := TSS (Utyp, TSS_Deep_Adjust);
          end if;
 
-      --  For types that are derived from Controlled and do not have controlled
-      --  components, build a call to Adjust.
+      --  Derivations from [Limited_]Controlled
+
+      elsif Is_Controlled (Utyp) then
+         if Has_Controlled_Component (Utyp) then
+            Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
+         else
+            Adj_Id := Find_Prim_Op (Utyp, Name_Of (Adjust_Case));
+         end if;
+
+      --  Tagged types
+
+      elsif Is_Tagged_Type (Utyp) then
+         Adj_Id := Find_Prim_Op (Utyp, TSS_Deep_Adjust);
 
       else
-         Adj_Id := Find_Prim_Op (Utyp, Name_Of (Adjust_Case));
+         raise Program_Error;
       end if;
 
       if Present (Adj_Id) then
@@ -5493,8 +5495,6 @@ package body Exp_Ch7 is
       --  have discriminants and contain variant parts. Generate:
       --
       --    begin
-      --       Root_Controlled (V).Finalized := False;
-      --
       --       begin
       --          [Deep_]Adjust (V.Comp_1);
       --       exception
@@ -5559,10 +5559,6 @@ package body Exp_Ch7 is
       --       Raised : Boolean := False;
       --
       --    begin
-      --       if Root_Controlled (V).Finalized then
-      --          return;
-      --       end if;
-      --
       --       if F then
       --          begin
       --             Finalize (V);  --  If applicable
@@ -5626,8 +5622,6 @@ package body Exp_Ch7 is
       --             end if;
       --       end;
       --
-      --       Root_Controlled (V).Finalized := True;
-      --
       --       if Raised then
       --          Raise_From_Controlled_Object (E, Abort);
       --       end if;
@@ -6040,8 +6034,6 @@ package body Exp_Ch7 is
          --       Raised : Boolean := False;
 
          --    begin
-         --       Root_Controlled (V).Finalized := False;
-
          --       <adjust statements>
 
          --       if Raised then
@@ -6846,15 +6838,6 @@ package body Exp_Ch7 is
             Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
          end if;
 
-      --  Derivations from [Limited_]Controlled
-
-      elsif Is_Controlled (Utyp) then
-         if Has_Controlled_Component (Utyp) then
-            Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
-         else
-            Fin_Id := Find_Prim_Op (Utyp, Name_Of (Finalize_Case));
-         end if;
-
       --  Class-wide types, interfaces and types with controlled components
 
       elsif Is_Class_Wide_Type (Typ)
@@ -6867,6 +6850,15 @@ package body Exp_Ch7 is
             Fin_Id := TSS (Utyp, TSS_Deep_Finalize);
          end if;
 
+      --  Derivations from [Limited_]Controlled
+
+      elsif Is_Controlled (Utyp) then
+         if Has_Controlled_Component (Utyp) then
+            Fin_Id := Find_Prim_Op (Utyp, TSS_Deep_Finalize);
+         else
+            Fin_Id := Find_Prim_Op (Utyp, Name_Of (Finalize_Case));
+         end if;
+
       --  Tagged types
 
       elsif Is_Tagged_Type (Utyp) then
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index a23a923..e06b9e0 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -3349,6 +3349,7 @@ package body Exp_Util is
                N_Formal_Ordinary_Fixed_Point_Definition |
                N_Formal_Package_Declaration             |
                N_Formal_Private_Type_Definition         |
+               N_Formal_Incomplete_Type_Definition      |
                N_Formal_Signed_Integer_Type_Definition  |
                N_Function_Call                          |
                N_Function_Specification                 |
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index 3532f09..3d366fd 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -1259,6 +1259,13 @@ package body Freeze is
 
                End_Package_Scope (E);
 
+               if Is_Generic_Instance (E)
+                 and then Has_Delayed_Freeze (E)
+               then
+                  Set_Has_Delayed_Freeze (E, False);
+                  Expand_N_Package_Declaration (Unit_Declaration_Node (E));
+               end if;
+
             elsif Ekind (E) in Task_Kind
               and then
                 (Nkind (Parent (E)) = N_Task_Type_Declaration
@@ -2297,6 +2304,17 @@ package body Freeze is
       elsif Inside_A_Generic and then External_Ref_In_Generic (Test_E) then
          return No_List;
 
+      --  AI05-0213: a formal incomplete type does not freeze the actual.
+      --  In the instance, the same applies to the subtype that renames
+      --  the actual.
+
+      elsif Is_Private_Type (E)
+        and then Is_Generic_Actual_Type (E)
+        and then No (Full_View (Base_Type (E)))
+        and then Ada_Version >= Ada_2012
+      then
+         return No_List;
+
       --  Do not freeze a global entity within an inner scope created during
       --  expansion. A call to subprogram E within some internal procedure
       --  (a stream attribute for example) might require freezing E, but the
@@ -2385,6 +2403,7 @@ package body Freeze is
                if Nkind (Ritem) = N_Aspect_Specification
                  and then Entity (Ritem) = E
                  and then Is_Delayed_Aspect (Ritem)
+                 and then Scope (E) = Current_Scope
                then
                   Aitem := Aspect_Rep_Item (Ritem);
 
diff --git a/gcc/ada/get_scos.adb b/gcc/ada/get_scos.adb
index 8ad5a44..923eb35 100644
--- a/gcc/ada/get_scos.adb
+++ b/gcc/ada/get_scos.adb
@@ -306,7 +306,8 @@ begin
                            Skipc;
 
                            begin
-                              Pid := Pragma_Id'Value (Buf (1 .. N));
+                              Pid :=
+                                Pragma_Id'Value ("pragma_" & Buf (1 .. N));
                            exception
                               when Constraint_Error =>
 
diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb
index a383d7c..470f4d6 100644
--- a/gcc/ada/make.adb
+++ b/gcc/ada/make.adb
@@ -5908,7 +5908,7 @@ package body Make is
          --  are not supposed to change.
 
          Osint.Source_File_Data (Cache => True);
-         Osint.Add_Default_Search_Dirs;
+
          Queue_Library_Project_Sources;
       end if;
 
@@ -5931,17 +5931,6 @@ package body Make is
            ("nothing to do for a main project that is externally built");
       end if;
 
-      --  Get the target parameters, which are only needed for a couple of
-      --  cases in gnatmake. Protect against an exception, such as the case of
-      --  system.ads missing from the library, and fail gracefully.
-
-      begin
-         Targparm.Get_Target_Parameters;
-      exception
-         when Unrecoverable_Error =>
-            Make_Failed ("*** make failed.");
-      end;
-
       --  Special processing for VM targets
 
       if Targparm.VM_Target /= No_VM then
@@ -6116,7 +6105,28 @@ package body Make is
             Compute_Builder  => Is_First_Main,
             Current_Work_Dir => Current_Work_Dir.all);
 
-         Is_First_Main := False;
+         if Is_First_Main then
+            --  Put the default source dirs in the source path only now,
+            --  so that we take the correct ones in the case when --RTS= is
+            --  specified in the Builder switches.
+
+            Osint.Add_Default_Search_Dirs;
+
+            --  Get the target parameters, which are only needed for a couple
+            --  of cases in gnatmake. Protect against an exception, such as the
+            --  case of system.ads missing from the library, and fail
+            --  gracefully.
+
+            begin
+               Targparm.Get_Target_Parameters;
+            exception
+               when Unrecoverable_Error =>
+                  Make_Failed ("*** make failed.");
+            end;
+
+            Is_First_Main := False;
+         end if;
+
          Executable_Obsolete := False;
 
          Compute_Executable
diff --git a/gcc/ada/par-ch12.adb b/gcc/ada/par-ch12.adb
index 49962d8..a7e5242 100644
--- a/gcc/ada/par-ch12.adb
+++ b/gcc/ada/par-ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -531,10 +531,39 @@ package body Ch12 is
            (Decl_Node, P_Known_Discriminant_Part_Opt);
       end if;
 
-      T_Is;
+      if Token = Tok_Semicolon then
+
+         --  Ada2012 :  incomplete formal type
+
+         Scan; -- past semicolon
+
+         if Ada_Version < Ada_2012 then
+            Error_Msg_N
+              ("`formal incomplete type` is an Ada 2012 feature", Decl_Node);
+            Error_Msg_N
+              ("\unit must be compiled with -gnat2012 switch", Decl_Node);
+         end if;
+
+         Set_Formal_Type_Definition
+           (Decl_Node,
+             New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr));
+         return Decl_Node;
+
+      else
+         T_Is;
+      end if;
 
       Def_Node := P_Formal_Type_Definition;
 
+      if Nkind (Def_Node) = N_Formal_Incomplete_Type_Definition
+        and then Ada_Version < Ada_2012
+      then
+         Error_Msg_N
+           ("`formal incomplete type` is an Ada 2012 feature", Decl_Node);
+         Error_Msg_N
+           ("\unit must be compiled with -gnat2012 switch", Decl_Node);
+      end if;
+
       if Def_Node /= Error then
          Set_Formal_Type_Definition (Decl_Node, Def_Node);
          P_Aspect_Specifications (Decl_Node);
@@ -563,6 +592,7 @@ package body Ch12 is
 
    --  FORMAL_TYPE_DEFINITION ::=
    --    FORMAL_PRIVATE_TYPE_DEFINITION
+   --  | FORMAL_INCOMPLETE_TYPE_DEFINITION
    --  | FORMAL_DERIVED_TYPE_DEFINITION
    --  | FORMAL_DISCRETE_TYPE_DEFINITION
    --  | FORMAL_SIGNED_INTEGER_TYPE_DEFINITION
@@ -704,10 +734,22 @@ package body Ch12 is
                return Error;
             end if;
 
-         when Tok_Private |
-              Tok_Tagged  =>
+         when Tok_Private  =>
             return P_Formal_Private_Type_Definition;
 
+         when  Tok_Tagged  =>
+            if Next_Token_Is (Tok_Semicolon) then
+               Typedef_Node :=
+                 New_Node (N_Formal_Incomplete_Type_Definition, Token_Ptr);
+               Set_Tagged_Present (Typedef_Node);
+
+               Scan;  --  past tagged
+               return Typedef_Node;
+
+            else
+               return P_Formal_Private_Type_Definition;
+            end if;
+
          when Tok_Range =>
             return P_Formal_Signed_Integer_Type_Definition;
 
diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb
index a4c0bb6..0e67bba 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;
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 59626e8..be0c907 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -674,6 +674,7 @@ package body Sem is
            N_Formal_Modular_Type_Definition         |
            N_Formal_Ordinary_Fixed_Point_Definition |
            N_Formal_Private_Type_Definition         |
+           N_Formal_Incomplete_Type_Definition      |
            N_Formal_Signed_Integer_Type_Definition  |
            N_Function_Specification                 |
            N_Generic_Association                    |
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 4965938..9e10682 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -342,6 +342,9 @@ package body Sem_Ch12 is
       Def : Node_Id);
    --  Creates a new private type, which does not require completion
 
+   procedure Analyze_Formal_Incomplete_Type (T   : Entity_Id; Def : Node_Id);
+   --  Ada2012 : Creates a new incomplete type, whose actual does not freeze.
+
    procedure Analyze_Generic_Formal_Part (N : Node_Id);
 
    procedure Analyze_Generic_Access_Type (T : Entity_Id; Def : Node_Id);
@@ -1300,9 +1303,14 @@ package body Sem_Ch12 is
                        Assoc);
 
                      --  An instantiation is a freeze point for the actuals,
-                     --  unless this is a rewritten formal package.
+                     --  unless this is a rewritten formal package, and
+                     --  unless it is an Ada2012 formal incomplete type.
 
-                     if Nkind (I_Node) /= N_Formal_Package_Declaration then
+                     if Nkind (I_Node) /= N_Formal_Package_Declaration
+                       and then
+                         Ekind (Defining_Identifier (Analyzed_Formal)) /=
+                           E_Incomplete_Type
+                     then
                         Append_Elmt (Entity (Match), Actual_Types);
                      end if;
                   end if;
@@ -2361,6 +2369,26 @@ package body Sem_Ch12 is
       Set_RM_Size   (T, RM_Size (Standard_Integer));
    end Analyze_Formal_Private_Type;
 
+   ------------------------------------
+   -- Analyze_Formal_Incomplete_Type --
+   ------------------------------------
+
+   procedure Analyze_Formal_Incomplete_Type
+     (T   : Entity_Id;
+      Def : Node_Id)
+   is
+   begin
+      Enter_Name (T);
+      Set_Ekind (T, E_Incomplete_Type);
+      Set_Etype (T, T);
+
+      if Tagged_Present (Def) then
+         Set_Is_Tagged_Type (T);
+         Make_Class_Wide_Type (T);
+         Set_Direct_Primitive_Operations (T, New_Elmt_List);
+      end if;
+   end Analyze_Formal_Incomplete_Type;
+
    ----------------------------------------
    -- Analyze_Formal_Signed_Integer_Type --
    ----------------------------------------
@@ -2594,6 +2622,9 @@ package body Sem_Ch12 is
          when N_Formal_Derived_Type_Definition         =>
             Analyze_Formal_Derived_Type (N, T, Def);
 
+         when N_Formal_Incomplete_Type_Definition         =>
+            Analyze_Formal_Incomplete_Type (T, Def);
+
          when N_Formal_Discrete_Type_Definition        =>
             Analyze_Formal_Discrete_Type (T, Def);
 
@@ -9447,9 +9478,13 @@ package body Sem_Ch12 is
       procedure Validate_Access_Type_Instance;
       procedure Validate_Derived_Type_Instance;
       procedure Validate_Derived_Interface_Type_Instance;
+      procedure Validate_Discriminated_Formal_Type;
       procedure Validate_Interface_Type_Instance;
       procedure Validate_Private_Type_Instance;
+      procedure Validate_Incomplete_Type_Instance;
       --  These procedures perform validation tests for the named case
+      --  Validate_Discriminated_Formal_Type is shared by formal private
+      --  types and Ada2012 formal incomplete types.
 
       function Subtypes_Match (Gen_T, Act_T : Entity_Id) return Boolean;
       --  Check that base types are the same and that the subtypes match
@@ -10272,73 +10307,17 @@ package body Sem_Ch12 is
          end if;
       end Validate_Derived_Type_Instance;
 
-      --------------------------------------
-      -- Validate_Interface_Type_Instance --
-      --------------------------------------
-
-      procedure Validate_Interface_Type_Instance is
-      begin
-         if not Is_Interface (Act_T) then
-            Error_Msg_NE
-              ("actual for formal interface type must be an interface",
-                Actual, Gen_T);
-
-         elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T)
-           or else
-             Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
-           or else
-             Is_Protected_Interface (A_Gen_T) /=
-               Is_Protected_Interface (Act_T)
-           or else
-             Is_Synchronized_Interface (A_Gen_T) /=
-               Is_Synchronized_Interface (Act_T)
-         then
-            Error_Msg_NE
-              ("actual for interface& does not match (RM 12.5.5(4))",
-               Actual, Gen_T);
-         end if;
-      end Validate_Interface_Type_Instance;
-
-      ------------------------------------
-      -- Validate_Private_Type_Instance --
-      ------------------------------------
+      ----------------------------------------
+      -- Validate_Discriminated_Formal_Type --
+      ----------------------------------------
 
-      procedure Validate_Private_Type_Instance is
+      procedure Validate_Discriminated_Formal_Type is
          Formal_Discr : Entity_Id;
          Actual_Discr : Entity_Id;
          Formal_Subt  : Entity_Id;
 
       begin
-         if Is_Limited_Type (Act_T)
-           and then not Is_Limited_Type (A_Gen_T)
-         then
-            Error_Msg_NE
-              ("actual for non-limited & cannot be a limited type", Actual,
-               Gen_T);
-            Explain_Limited_Type (Act_T, Actual);
-            Abandon_Instantiation (Actual);
-
-         elsif Known_To_Have_Preelab_Init (A_Gen_T)
-           and then not Has_Preelaborable_Initialization (Act_T)
-         then
-            Error_Msg_NE
-              ("actual for & must have preelaborable initialization", Actual,
-               Gen_T);
-
-         elsif Is_Indefinite_Subtype (Act_T)
-            and then not Is_Indefinite_Subtype (A_Gen_T)
-            and then Ada_Version >= Ada_95
-         then
-            Error_Msg_NE
-              ("actual for & must be a definite subtype", Actual, Gen_T);
-
-         elsif not Is_Tagged_Type (Act_T)
-           and then Is_Tagged_Type (A_Gen_T)
-         then
-            Error_Msg_NE
-              ("actual for & must be a tagged type", Actual, Gen_T);
-
-         elsif Has_Discriminants (A_Gen_T) then
+         if Has_Discriminants (A_Gen_T) then
             if not Has_Discriminants (Act_T) then
                Error_Msg_NE
                  ("actual for & must have discriminants", Actual, Gen_T);
@@ -10403,9 +10382,89 @@ package body Sem_Ch12 is
                   Abandon_Instantiation (Actual);
                end if;
             end if;
+         end if;
+      end Validate_Discriminated_Formal_Type;
+
+      ---------------------------------------
+      -- Validate_Incomplete_Type_Instance --
+      ---------------------------------------
 
+      procedure Validate_Incomplete_Type_Instance is
+      begin
+         if not Is_Tagged_Type (Act_T)
+           and then Is_Tagged_Type (A_Gen_T)
+         then
+            Error_Msg_NE
+              ("actual for & must be a tagged type", Actual, Gen_T);
+         end if;
+
+         Validate_Discriminated_Formal_Type;
+      end Validate_Incomplete_Type_Instance;
+
+      --------------------------------------
+      -- Validate_Interface_Type_Instance --
+      --------------------------------------
+
+      procedure Validate_Interface_Type_Instance is
+      begin
+         if not Is_Interface (Act_T) then
+            Error_Msg_NE
+              ("actual for formal interface type must be an interface",
+                Actual, Gen_T);
+
+         elsif Is_Limited_Type (Act_T) /= Is_Limited_Type (A_Gen_T)
+           or else
+             Is_Task_Interface (A_Gen_T) /= Is_Task_Interface (Act_T)
+           or else
+             Is_Protected_Interface (A_Gen_T) /=
+               Is_Protected_Interface (Act_T)
+           or else
+             Is_Synchronized_Interface (A_Gen_T) /=
+               Is_Synchronized_Interface (Act_T)
+         then
+            Error_Msg_NE
+              ("actual for interface& does not match (RM 12.5.5(4))",
+               Actual, Gen_T);
          end if;
+      end Validate_Interface_Type_Instance;
+
+      ------------------------------------
+      -- Validate_Private_Type_Instance --
+      ------------------------------------
 
+      procedure Validate_Private_Type_Instance is
+      begin
+         if Is_Limited_Type (Act_T)
+           and then not Is_Limited_Type (A_Gen_T)
+         then
+            Error_Msg_NE
+              ("actual for non-limited & cannot be a limited type", Actual,
+               Gen_T);
+            Explain_Limited_Type (Act_T, Actual);
+            Abandon_Instantiation (Actual);
+
+         elsif Known_To_Have_Preelab_Init (A_Gen_T)
+           and then not Has_Preelaborable_Initialization (Act_T)
+         then
+            Error_Msg_NE
+              ("actual for & must have preelaborable initialization", Actual,
+               Gen_T);
+
+         elsif Is_Indefinite_Subtype (Act_T)
+            and then not Is_Indefinite_Subtype (A_Gen_T)
+            and then Ada_Version >= Ada_95
+         then
+            Error_Msg_NE
+              ("actual for & must be a definite subtype", Actual, Gen_T);
+
+         elsif not Is_Tagged_Type (Act_T)
+           and then Is_Tagged_Type (A_Gen_T)
+         then
+            Error_Msg_NE
+              ("actual for & must be a tagged type", Actual, Gen_T);
+         end if;
+
+         Validate_Discriminated_Formal_Type;
          Ancestor := Gen_T;
       end Validate_Private_Type_Instance;
 
@@ -10463,7 +10522,13 @@ package body Sem_Ch12 is
                       and then
                          Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
          then
-            if Is_Class_Wide_Type (Act_T)
+            --  If the formal is an incomplete type, the actual can be
+            --  incomplete as well.
+
+            if Ekind (A_Gen_T) = E_Incomplete_Type then
+               null;
+
+            elsif Is_Class_Wide_Type (Act_T)
               or else No (Full_View (Act_T))
             then
                Error_Msg_N ("premature use of incomplete type", Actual);
@@ -10486,7 +10551,14 @@ package body Sem_Ch12 is
            and then not Is_Derived_Type (Act_T)
            and then No (Full_View (Root_Type (Act_T)))
          then
-            Error_Msg_N ("premature use of private type", Actual);
+            --  If the formal is an incomplete type, the actual can be
+            --  private or incomplete as well.
+
+            if Ekind (A_Gen_T) = E_Incomplete_Type then
+               null;
+            else
+               Error_Msg_N ("premature use of private type", Actual);
+            end if;
 
          elsif Has_Private_Component (Act_T) then
             Error_Msg_N
@@ -10528,6 +10600,9 @@ package body Sem_Ch12 is
             when N_Formal_Private_Type_Definition =>
                Validate_Private_Type_Instance;
 
+            when N_Formal_Incomplete_Type_Definition =>
+               Validate_Incomplete_Type_Instance;
+
             when N_Formal_Derived_Type_Definition =>
                Validate_Derived_Type_Instance;
 
@@ -10642,7 +10717,10 @@ package body Sem_Ch12 is
             Set_Generic_Parent_Type (Decl_Node, Ancestor);
          end if;
 
-      elsif Nkind (Def) = N_Formal_Private_Type_Definition then
+      elsif Nkind_In (Def,
+        N_Formal_Private_Type_Definition,
+        N_Formal_Incomplete_Type_Definition)
+      then
          Set_Generic_Parent_Type (Decl_Node, A_Gen_T);
       end if;
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index cfb5b55..13e4a6a 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2344,10 +2344,12 @@ package body Sem_Ch6 is
          --  expand the freeze actions that include the bodies. In particular,
          --  extra formals for accessibility or for return-in-place may need
          --  to be generated. Freeze nodes, if any, are inserted before the
-         --  current body.
+         --  current body. These freeze actions are also needed in ASIS mode
+         --  to enable the proper back-annotations.
 
          if not Is_Frozen (Spec_Id)
-           and then Expander_Active
+           and then
+             (Expander_Active or else ASIS_Mode)
          then
             --  Force the generation of its freezing node to ensure proper
             --  management of access types in the backend.
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 62f4abd..471d0f8 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -1195,9 +1195,11 @@ package body Sem_Ch7 is
       while Present (E) loop
 
          --  Check on incomplete types
+         --  AI05-213 : a formal incomplete type has no completion.
 
          if Ekind (E) = E_Incomplete_Type
            and then No (Full_View (E))
+           and then not Is_Generic_Type (E)
          then
             Error_Msg_N ("no declaration in visible part for incomplete}", E);
          end if;
@@ -2585,7 +2587,9 @@ package body Sem_Ch7 is
                and then Unit_Requires_Body (E))
 
            or else
-             (Ekind (E) = E_Incomplete_Type and then No (Full_View (E)))
+             (Ekind (E) = E_Incomplete_Type
+               and then No (Full_View (E))
+               and then not Is_Generic_Type (E))
 
            or else
             ((Ekind (E) = E_Task_Type or else
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index 11e8aa0..d1f0067 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -2930,6 +2930,7 @@ package body Sinfo is
       (N : Node_Id) return Boolean is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Incomplete_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Incomplete_Type_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
@@ -5971,6 +5972,7 @@ package body Sinfo is
       (N : Node_Id; Val : Boolean := True) is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Formal_Incomplete_Type_Definition
         or else NT (N).Nkind = N_Formal_Private_Type_Definition
         or else NT (N).Nkind = N_Incomplete_Type_Declaration
         or else NT (N).Nkind = N_Private_Type_Declaration
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index eb9b476..07f532e 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -6209,6 +6209,7 @@ package Sinfo is
       --    type DEFINING_IDENTIFIER [DISCRIMINANT_PART]
       --      is FORMAL_TYPE_DEFINITION
       --        [ASPECT_SPECIFICATIONS];
+      --  | type DEFINING_IDENTIFIER [DISCRIMINANT_PART] [is tagged]
 
       --  N_Formal_Type_Declaration
       --  Sloc points to TYPE
@@ -6234,6 +6235,12 @@ package Sinfo is
       --  | FORMAL_ARRAY_TYPE_DEFINITION
       --  | FORMAL_ACCESS_TYPE_DEFINITION
       --  | FORMAL_INTERFACE_TYPE_DEFINITION
+      --  | FORMAL_INCOMPLETE_TYPE_DEFINITION
+
+      --  The Ada2012 syntax introduces two new non-terminals;
+      --  Formal_[Complete_| Incomplete_] Type_Declaration just to introduce
+      --  the later category. Here we introduce an incomplete type definition
+      --  in order to preserve as much as possible the existing structure.
 
       ---------------------------------------------
       -- 12.5.1  Formal Private Type Definition --
@@ -6268,6 +6275,17 @@ package Sinfo is
       --  Synchronized_Present (Flag7)
       --  Interface_List (List2) (set to No_List if none)
 
+      ------------------------------------------------
+      -- 12.5.1  Formal Incomplete  Type Definition --
+      ------------------------------------------------
+
+      --  FORMAL_INCOMPLETE_TYPE_DEFINITION ::=
+      --  [tagged]
+
+      --  N_Formal_Incomplete_Type_Definition
+      --  Sloc points to identifier of parent
+      --  Tagged_Present (Flag15)
+
       ---------------------------------------------
       -- 12.5.2  Formal Discrete Type Definition --
       ---------------------------------------------
@@ -7805,6 +7823,7 @@ package Sinfo is
       N_Formal_Ordinary_Fixed_Point_Definition,
       N_Formal_Package_Declaration,
       N_Formal_Private_Type_Definition,
+      N_Formal_Incomplete_Type_Definition,
       N_Formal_Signed_Integer_Type_Definition,
       N_Freeze_Entity,
       N_Generic_Association,
@@ -11320,6 +11339,13 @@ package Sinfo is
         4 => False,   --  unused
         5 => False),  --  unused
 
+     N_Formal_Incomplete_Type_Definition =>
+       (1 => False,   --  unused
+        2 => False,   --  unused
+        3 => False,   --  unused
+        4 => False,   --  unused
+        5 => False),  --  unused
+
      N_Formal_Derived_Type_Definition =>
        (1 => False,   --  unused
         2 => True,    --  Interface_List (List2)
diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb
index 5c6f329..0ccd8c2 100644
--- a/gcc/ada/sprint.adb
+++ b/gcc/ada/sprint.adb
@@ -1801,6 +1801,11 @@ package body Sprint is
 
             Write_Str_With_Col_Check_Sloc ("private");
 
+         when N_Formal_Incomplete_Type_Definition =>
+            if Tagged_Present (Node) then
+               Write_Str_With_Col_Check ("is tagged ");
+            end if;
+
          when N_Formal_Signed_Integer_Type_Definition =>
             Write_Str_With_Col_Check_Sloc ("range <>");
 
@@ -1814,7 +1819,12 @@ package body Sprint is
                Write_Str_With_Col_Check ("(<>)");
             end if;
 
-            Write_Str_With_Col_Check (" is ");
+            if Nkind (Formal_Type_Definition (Node)) /=
+                N_Formal_Incomplete_Type_Definition
+            then
+               Write_Str_With_Col_Check (" is ");
+            end if;
+
             Sprint_Node (Formal_Type_Definition (Node));
             Write_Char (';');