Skip to content

R
riscv-gcc-1
Commit 8da337c5 by Arnaud Charlet
Options

[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
parent dcffd515
Showing with 84 additions and 33 deletions
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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment