mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-14 00:21:05 +08:00
Code Issues Packages Projects Releases Wiki Activity

[multiple changes]

Browse Source 
2009-04-17  Thomas Quinot  <quinot@adacore.com>

	* sinfo.ads, exp_aggr.adb, exp_aggr.ads: Minor reformatting

	* exp_ch7.adb: Minor reformatting

2009-04-17  Bob Duff  <duff@adacore.com>

	* exp_ch4.adb (Expand_Allocator_Expression): In an initialized
	allocator, check that the expression of the qualified expression obeys
	the constraints of the subtype of the qualified expression.

2009-04-17  Thomas Quinot  <quinot@adacore.com>

	* sprint.adb (Write_Itype): Add handling of enumeration subtypes.

From-SVN: r146239
This commit is contained in:
Arnaud Charlet 2009-04-17 12:14:36 +02:00
parent cac5a8014c
commit 36c7355262
7 changed files with 63 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
2009-04-17 Thomas Quinot <quinot@adacore.com>
* sinfo.ads, exp_aggr.adb, exp_aggr.ads: Minor reformatting
* exp_ch7.adb: Minor reformatting
2009-04-17 Bob Duff <duff@adacore.com>
* exp_ch4.adb (Expand_Allocator_Expression): In an initialized
allocator, check that the expression of the qualified expression obeys
the constraints of the subtype of the qualified expression.
2009-04-17 Thomas Quinot <quinot@adacore.com>
* sprint.adb (Write_Itype): Add handling of enumeration subtypes.
2009-04-17 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_Allocator_Expression): Apply constraint check to

28
gcc/ada/exp_aggr.adb
View File

@ -3506,10 +3506,10 @@ package body Exp_Aggr is
Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
end if;
-- If the aggregate is non-limited, create a temporary. If it is
-- limited and the context is an assignment, this is a subaggregate
-- for an enclosing aggregate being expanded. It must be built in place,
-- so use the target of the current assignment.
-- If the aggregate is non-limited, create a temporary. If it is limited
-- and the context is an assignment, this is a subaggregate for an
-- enclosing aggregate being expanded. It must be built in place, so use
-- the target of the current assignment.
if Is_Limited_Type (Typ)
and then Nkind (Parent (N)) = N_Assignment_Statement
@ -4947,8 +4947,8 @@ package body Exp_Aggr is
-- STEP 3
-- Delay expansion for nested aggregates it will be taken care of
-- when the parent aggregate is expanded
-- Delay expansion for nested aggregates: it will be taken care of
-- when the parent aggregate is expanded.
Parent_Node := Parent (N);
Parent_Kind := Nkind (Parent_Node);
@ -4979,7 +4979,7 @@ package body Exp_Aggr is
-- STEP 4
-- Look if in place aggregate expansion is possible
-- Look if in place aggregate expansion is possible.
-- For object declarations we build the aggregate in place, unless
-- the array is bit-packed or the component is controlled.
@ -5018,8 +5018,8 @@ package body Exp_Aggr is
and then In_Place_Assign_OK);
end if;
-- If this is an array of tasks, it will be expanded into build-in-
-- -place assignments. Build an activation chain for the tasks now
-- If this is an array of tasks, it will be expanded into build-in-place
-- assignments. Build an activation chain for the tasks now.
if Has_Task (Etype (N)) then
Build_Activation_Chain_Entity (N);
@ -5114,8 +5114,8 @@ package body Exp_Aggr is
Set_No_Initialization (Tmp_Decl, True);
-- If we are within a loop, the temporary will be pushed on the
-- stack at each iteration. If the aggregate is the expression for
-- an allocator, it will be immediately copied to the heap and can
-- stack at each iteration. If the aggregate is the expression for an
-- allocator, it will be immediately copied to the heap and can
-- be reclaimed at once. We create a transient scope around the
-- aggregate for this purpose.
@ -5128,9 +5128,9 @@ package body Exp_Aggr is
Insert_Action (N, Tmp_Decl);
end if;
-- Construct and insert the aggregate code. We can safely suppress
-- index checks because this code is guaranteed not to raise CE
-- on index checks. However we should *not* suppress all checks.
-- Construct and insert the aggregate code. We can safely suppress index
-- checks because this code is guaranteed not to raise CE on index
-- checks. However we should *not* suppress all checks.
declare
Target : Node_Id;

6
gcc/ada/exp_aggr.ads
View File

@ -34,9 +34,9 @@ package Exp_Aggr is
-- Returns True if N is an aggregate of some kind whose Expansion_Delayed
-- flag is set (see sinfo for meaning of flag).
procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-- N is a N_Object_Declaration with an expression which must be
-- an N_Aggregate or N_Extension_Aggregate with Expansion_Delayed
procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-- N is a N_Object_Declaration with an expression which must be an
-- N_Aggregate or N_Extension_Aggregate with Expansion_Delayed.
-- This procedure performs in-place aggregate assignment.
procedure Convert_Aggr_In_Allocator

25
gcc/ada/exp_ch4.adb
View File

@ -977,15 +977,14 @@ package body Exp_Ch4 is
Rewrite (Exp, New_Copy (Expression (Exp)));
end if;
else
-- First check against the type of the qualified expression
--
-- NOTE: The commented call should be correct, but for some reason
-- causes the compiler to bomb (sigsegv) on ACVC test c34007g, so for
-- now we just perform the old (incorrect) test against the
-- designated subtype with no sliding in the else part of the if
-- statement below. ???
--
-- Apply_Constraint_Check (Exp, T, No_Sliding => True);
-- If we have:
-- type A is access T1;
-- X : A := new T2'(...);
-- T1 and T2 can be different subtypes, and we might need to check
-- both constraints. First check against the type of the qualified
-- expression.
Apply_Constraint_Check (Exp, T, No_Sliding => True);
-- A check is also needed in cases where the designated subtype is
-- constrained and differs from the subtype given in the qualified
@ -997,14 +996,6 @@ package body Exp_Ch4 is
then
Apply_Constraint_Check
(Exp, DesigT, No_Sliding => False);
-- The nonsliding check should really be performed (unconditionally)
-- against the subtype of the qualified expression, but that causes a
-- problem with c34007g (see above), so for now we retain this.
else
Apply_Constraint_Check
(Exp, DesigT, No_Sliding => True);
end if;
-- For an access to unconstrained packed array, GIGI needs to see an

37
gcc/ada/exp_ch7.adb
View File

@ -87,11 +87,11 @@ package body Exp_Ch7 is
-- (See Wrap_Transient_Expression for details)
-- 3. In a expression of an object_declaration. No wrapping is possible
-- here, so the finalization actions, if any are done right after the
-- here, so the finalization actions, if any, are done right after the
-- declaration and the secondary stack deallocation is done in the
-- proper enclosing scope (see Wrap_Transient_Declaration for details)
-- Note about functions returning tagged types: It has been decided to
-- Note about functions returning tagged types: it has been decided to
-- always allocate their result in the secondary stack, even though is not
-- absolutely mandatory when the tagged type is constrained because the
-- caller knows the size of the returned object and thus could allocate the
@ -124,10 +124,9 @@ package body Exp_Ch7 is
--------------------------------------------------
function Find_Node_To_Be_Wrapped (N : Node_Id) return Node_Id;
-- N is a node which may generate a transient scope. Loop over the
-- parent pointers of N until it find the appropriate node to
-- wrap. It it returns Empty, it means that no transient scope is
-- needed in this context.
-- N is a node which may generate a transient scope. Loop over the parent
-- pointers of N until it find the appropriate node to wrap. If it returns
-- Empty, it means that no transient scope is needed in this context.
function Make_Clean
(N : Node_Id;
@ -158,14 +157,14 @@ package body Exp_Ch7 is
procedure Insert_Actions_In_Scope_Around (N : Node_Id);
-- Insert the before-actions kept in the scope stack before N, and the
-- after after-actions, after N which must be a member of a list.
-- after-actions after N, which must be a member of a list.
function Make_Transient_Block
(Loc : Source_Ptr;
Action : Node_Id) return Node_Id;
-- Create a transient block whose name is Scope, which is also a
-- controlled block if Flist is not empty and whose only code is
-- Action (either a single statement or single declaration).
-- Create a transient block whose name is Scope, which is also a controlled
-- block if Flist is not empty and whose only code is Action (either a
-- single statement or single declaration).
type Final_Primitives is (Initialize_Case, Adjust_Case, Finalize_Case);
-- This enumeration type is defined in order to ease sharing code for
@ -193,26 +192,24 @@ package body Exp_Ch7 is
(Prim : Final_Primitives;
Typ : Entity_Id;
Stmts : List_Id) return Node_Id;
-- This function generates the tree for Deep_Initialize, Deep_Adjust
-- or Deep_Finalize procedures according to the first parameter,
-- these procedures operate on the type Typ. The Stmts parameter
-- gives the body of the procedure.
-- This function generates the tree for Deep_Initialize, Deep_Adjust or
-- Deep_Finalize procedures according to the first parameter, these
-- procedures operate on the type Typ. The Stmts parameter gives the body
-- of the procedure.
function Make_Deep_Array_Body
(Prim : Final_Primitives;
Typ : Entity_Id) return List_Id;
-- This function generates the list of statements for implementing
-- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures
-- according to the first parameter, these procedures operate on the
-- array type Typ.
-- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures according to
-- the first parameter, these procedures operate on the array type Typ.
function Make_Deep_Record_Body
(Prim : Final_Primitives;
Typ : Entity_Id) return List_Id;
-- This function generates the list of statements for implementing
-- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures
-- according to the first parameter, these procedures operate on the
-- record type Typ.
-- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures according to
-- the first parameter, these procedures operate on the record type Typ.
procedure Check_Visibly_Controlled
(Prim : Final_Primitives;

2
gcc/ada/sinfo.ads
View File

@ -976,7 +976,7 @@ package Sinfo is
-- Expansion_Delayed (Flag11-Sem)
-- Set on aggregates and extension aggregates that need a top-down rather
-- than bottom up expansion. Typically aggregate expansion happens bottom
-- than bottom-up expansion. Typically aggregate expansion happens bottom
-- up. For nested aggregates the expansion is delayed until the enclosing
-- aggregate itself is expanded, e.g. in the context of a declaration. To
-- delay it we set this flag. This is done to avoid creating a temporary

6
gcc/ada/sprint.adb
View File

@ -3768,11 +3768,13 @@ package body Sprint is
Write_Char (')');
-- Signed integer types, and modular integer subtypes
-- Signed integer types, and modular integer subtypes,
-- and also enumeration subtypes.
when E_Signed_Integer_Type |
E_Signed_Integer_Subtype |
E_Modular_Integer_Subtype =>
E_Modular_Integer_Subtype |
E_Enumeration_Subtype =>
Write_Header (Ekind (Typ) = E_Signed_Integer_Type);