* 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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@165104
138bc75d-0d04-0410-961f-
82ee72b054a4
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
-- 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
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;
-- 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 --
----------------------------
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
-- 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));
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
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);
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);
-- 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
projects / platform / upstream / linaro-gcc.git / commitdiff