aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2010-10-07 15:06:22 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2010-10-07 15:06:22 +0200
commit8da337c5025772d12fd6e6c9bfcc8fbd1307461a (patch)
tree4f4a5f0b697a0462eb05ecd4890bfa273f445573 /gcc/ada
parentdcffd51576e6d3c1f8059656b5853608534fa63d (diff)
downloadgcc-8da337c5025772d12fd6e6c9bfcc8fbd1307461a.zip
gcc-8da337c5025772d12fd6e6c9bfcc8fbd1307461a.tar.gz
gcc-8da337c5025772d12fd6e6c9bfcc8fbd1307461a.tar.bz2
[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
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog22
-rw-r--r--gcc/ada/einfo.ads12
-rw-r--r--gcc/ada/exp_aggr.adb54
-rw-r--r--gcc/ada/sem_aggr.adb17
-rw-r--r--gcc/ada/sem_ch13.adb2
-rw-r--r--gcc/ada/sem_res.adb10
6 files changed, 84 insertions, 33 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index a5d6633..070e8e5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,27 @@
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
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index ed91d5e..6c1aa2f 100644
--- a/gcc/ada/einfo.ads
+++ b/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
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 27ad463..3a7e46f 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/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
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 50af15c..6ef11bb 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/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);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index a583dde..bfa1373 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/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);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 9dafd64..56a53be 100644
--- a/gcc/ada/sem_res.adb
+++ b/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