[multiple changes]

2010-10-07  Robert Dewar  <dewar@adacore.com>

	* einfo.ads (No_Pool_Assigned): Update documentation.
	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
	Storage_Size): We only set No_Pool_Assigned if the expression is a
	static constant and zero.
	* sem_res.adb (Resolve_Allocator): Allocation from empty storage pool
	should be an error not a warning.

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Expand_Array_Aggregate): Recognize additional cases
	where an aggregate in an assignment can be built directly into the
	target, and does not require the creation of a temporary that may
	overflow the stack.

2010-10-07  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Analyze_Record_Aggregate): In Ada2012, a choice list
	in a record aggregate can correspond to several components of
	anonymous access types, as long as the designated subtypes match.

From-SVN: r165104

gcc/ada/ChangeLog

 2010-10-07  Robert Dewar  <dewar@adacore.com>
 
+	* einfo.ads (No_Pool_Assigned): Update documentation.
+	* sem_ch13.adb (Analyze_Attribute_Definition_Clause, case
+	Storage_Size): We only set No_Pool_Assigned if the expression is a
+	static constant and zero.
+	* sem_res.adb (Resolve_Allocator): Allocation from empty storage pool
+	should be an error not a warning.
+
+2010-10-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_aggr.adb (Expand_Array_Aggregate): Recognize additional cases
+	where an aggregate in an assignment can be built directly into the
+	target, and does not require the creation of a temporary that may
+	overflow the stack.
+
+2010-10-07  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Analyze_Record_Aggregate): In Ada2012, a choice list
+	in a record aggregate can correspond to several components of
+	anonymous access types, as long as the designated subtypes match.
+
+2010-10-07  Robert Dewar  <dewar@adacore.com>
+
 	* gnat_rm.texi, exp_util.adb, sinfo.adb, sinfo.ads, sem_ch12.adb,
 	sem.adb, gnat_ugn.texi, sem_util.ads, par-ch6.adb, targparm.ads,
 	restrict.adb, sem_ch6.adb, sem_ch6.ads, sprint.adb, i-c.ads: Change

gcc/ada/einfo.ads

@@ -3035,12 +3035,12 @@ package Einfo is
 --       interpreted as true. Currently this is set true for derived Boolean
 --       types which have a convention of C, C++ or Fortran.
 
---    No_Pool_Assigned (Flag131) [root type only]
---       Present in access types. Set if a storage size clause applies to
---       the variable with a compile time known value of zero. This flag is
---       used to generate warnings if any attempt is made to allocate or free
---       an instance of such an access type. This is set only in the root
---       type, since derived types must have the same pool.
+--    No_Pool_Assigned (Flag131) [root type only] Present in access types.
+--       Set if a storage size clause applies to the variable with a static
+--       expression value of zero. This flag is used to generate errors if any
+--       attempt is made to allocate or free an instance of such an access
+--       type. This is set only in the root type, since derived types must
+--       have the same pool.
 
 --    No_Return (Flag113)
 --       Present in all entities. Always false except in the case of procedures

gcc/ada/exp_aggr.adb

@@ -3768,12 +3768,13 @@ package body Exp_Aggr is
          then
             Expr := First (Component_Associations (N));
             while Present (Expr) loop
-               if Nkind (Expression (Expr)) = N_Integer_Literal then
+               if Nkind_In (Expression (Expr), N_Integer_Literal,
+                                               N_Real_Literal)
+               then
                   null;
 
                elsif Nkind (Expression (Expr)) /= N_Aggregate
-                 or else
-                   not Compile_Time_Known_Aggregate (Expression (Expr))
+                 or else not Compile_Time_Known_Aggregate (Expression (Expr))
                  or else Expansion_Delayed (Expression (Expr))
                then
                   Static_Components := False;
@@ -4194,6 +4195,11 @@ package body Exp_Aggr is
       --  Sub_Aggr is an array sub-aggregate. Dim is the dimension
       --  corresponding to the sub-aggregate.
 
+      function Safe_Left_Hand_Side (N : Node_Id) return Boolean;
+      --  In addition to Maybe_In_Place_OK, in order for an aggregate to be
+      --  built directly into the target of the assignment it must be free
+      --  of side-effects.
+
       ----------------------------
       -- Build_Constrained_Type --
       ----------------------------
@@ -4922,7 +4928,33 @@ package body Exp_Aggr is
          end if;
       end Others_Check;
 
-      --  Remaining Expand_Array_Aggregate variables
+      -------------------------
+      -- Safe_Left_Hand_Side --
+      -------------------------
+
+      function Safe_Left_Hand_Side (N : Node_Id) return Boolean is
+      begin
+         if Is_Entity_Name (N) then
+            return True;
+
+         elsif Nkind_In (N, N_Explicit_Dereference, N_Selected_Component)
+           and then Safe_Left_Hand_Side (Prefix (N))
+         then
+            return True;
+
+         elsif Nkind (N) = N_Indexed_Component
+           and then Safe_Left_Hand_Side (Prefix (N))
+           and then
+             (Is_Entity_Name (First (Expressions (N)))
+               or else Nkind (First (Expressions (N))) = N_Integer_Literal)
+         then
+            return True;
+         else
+            return False;
+         end if;
+      end Safe_Left_Hand_Side;
+
+      --  Local variables
 
       Tmp : Entity_Id;
       --  Holds the temporary aggregate value
@@ -5230,9 +5262,9 @@ package body Exp_Aggr is
       --  In the remaining cases the aggregate is the RHS of an assignment
 
       elsif Maybe_In_Place_OK
-        and then Is_Entity_Name (Name (Parent (N)))
+        and then Safe_Left_Hand_Side (Name (Parent (N)))
       then
-         Tmp := Entity (Name (Parent (N)));
+         Tmp := Name (Parent (N));
 
          if Etype (Tmp) /= Etype (N) then
             Apply_Length_Check (N, Etype (Tmp));
@@ -5246,16 +5278,6 @@ package body Exp_Aggr is
          end if;
 
       elsif Maybe_In_Place_OK
-        and then Nkind (Name (Parent (N))) = N_Explicit_Dereference
-        and then Is_Entity_Name (Prefix (Name (Parent (N))))
-      then
-         Tmp := Name (Parent (N));
-
-         if Etype (Tmp) /= Etype (N) then
-            Apply_Length_Check (N, Etype (Tmp));
-         end if;
-
-      elsif Maybe_In_Place_OK
         and then Nkind (Name (Parent (N))) = N_Slice
         and then Safe_Slice_Assignment (N)
       then

gcc/ada/sem_aggr.adb

@@ -3890,8 +3890,23 @@ package body Sem_Aggr is
                elsif No (Typech) then
                   Typech := Base_Type (Etype (Component));
 
+               --  AI05-0199: In Ada2012, several components of anonymous
+               --  access types can appear in a choice list, as long as the
+               --  designated types match.
+
                elsif Typech /= Base_Type (Etype (Component)) then
-                  if not Box_Present (Parent (Selectr)) then
+                  if Ada_Version >= Ada_12
+                    and then Ekind (Typech) = E_Anonymous_Access_Type
+                    and then
+                       Ekind (Etype (Component)) = E_Anonymous_Access_Type
+                    and then Base_Type (Designated_Type (Typech)) =
+                             Base_Type (Designated_Type (Etype (Component)))
+                    and then
+                      Subtypes_Statically_Match (Typech, (Etype (Component)))
+                  then
+                     null;
+
+                  elsif not Box_Present (Parent (Selectr)) then
                      Error_Msg_N
                        ("components in choice list must have same type",
                         Selectr);

gcc/ada/sem_ch13.adb

@@ -1859,7 +1859,7 @@ package body Sem_Ch13 is
                      return;
                   end if;
 
-                  if Compile_Time_Known_Value (Expr)
+                  if Is_OK_Static_Expression (Expr)
                     and then Expr_Value (Expr) = 0
                   then
                      Set_No_Pool_Assigned (Btype);

gcc/ada/sem_res.adb

@@ -4296,15 +4296,7 @@ package body Sem_Res is
       --  Check for allocation from an empty storage pool
 
       if No_Pool_Assigned (Typ) then
-         declare
-            Loc : constant Source_Ptr := Sloc (N);
-         begin
-            Error_Msg_N ("?allocation from empty storage pool!", N);
-            Error_Msg_N ("\?Storage_Error will be raised at run time!", N);
-            Insert_Action (N,
-              Make_Raise_Storage_Error (Loc,
-                Reason => SE_Empty_Storage_Pool));
-         end;
+         Error_Msg_N ("allocation from empty storage pool!", N);
 
       --  If the context is an unchecked conversion, as may happen within
       --  an inlined subprogram, the allocator is being resolved with its