git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

[multiple changes] 

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> 2009-04-17 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_Allocator_Expression): Apply constraint check to * 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)); Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
end if; end if;
-- If the aggregate is non-limited, create a temporary. If it is -- If the aggregate is non-limited, create a temporary. If it is limited
-- limited and the context is an assignment, this is a subaggregate -- and the context is an assignment, this is a subaggregate for an
-- for an enclosing aggregate being expanded. It must be built in place, -- enclosing aggregate being expanded. It must be built in place, so use
-- so use the target of the current assignment. -- the target of the current assignment.
if Is_Limited_Type (Typ) if Is_Limited_Type (Typ)
and then Nkind (Parent (N)) = N_Assignment_Statement and then Nkind (Parent (N)) = N_Assignment_Statement
@ -4947,8 +4947,8 @@ package body Exp_Aggr is
-- STEP 3 -- STEP 3
-- Delay expansion for nested aggregates it will be taken care of -- Delay expansion for nested aggregates: it will be taken care of
-- when the parent aggregate is expanded -- when the parent aggregate is expanded.
Parent_Node := Parent (N); Parent_Node := Parent (N);
Parent_Kind := Nkind (Parent_Node); Parent_Kind := Nkind (Parent_Node);
@ -4979,7 +4979,7 @@ package body Exp_Aggr is
-- STEP 4 -- 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 -- For object declarations we build the aggregate in place, unless
-- the array is bit-packed or the component is controlled. -- 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); and then In_Place_Assign_OK);
end if; end if;
-- If this is an array of tasks, it will be expanded into build-in- -- If this is an array of tasks, it will be expanded into build-in-place
-- -place assignments. Build an activation chain for the tasks now -- assignments. Build an activation chain for the tasks now.
if Has_Task (Etype (N)) then if Has_Task (Etype (N)) then
Build_Activation_Chain_Entity (N); Build_Activation_Chain_Entity (N);
@ -5114,8 +5114,8 @@ package body Exp_Aggr is
Set_No_Initialization (Tmp_Decl, True); Set_No_Initialization (Tmp_Decl, True);
-- If we are within a loop, the temporary will be pushed on the -- If we are within a loop, the temporary will be pushed on the
-- stack at each iteration. If the aggregate is the expression for -- stack at each iteration. If the aggregate is the expression for an
-- an allocator, it will be immediately copied to the heap and can -- allocator, it will be immediately copied to the heap and can
-- be reclaimed at once. We create a transient scope around the -- be reclaimed at once. We create a transient scope around the
-- aggregate for this purpose. -- aggregate for this purpose.
@ -5128,9 +5128,9 @@ package body Exp_Aggr is
Insert_Action (N, Tmp_Decl); Insert_Action (N, Tmp_Decl);
end if; end if;
-- Construct and insert the aggregate code. We can safely suppress -- Construct and insert the aggregate code. We can safely suppress index
-- index checks because this code is guaranteed not to raise CE -- checks because this code is guaranteed not to raise CE on index
-- on index checks. However we should *not* suppress all checks. -- checks. However we should *not* suppress all checks.
declare declare
Target : Node_Id; 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 -- Returns True if N is an aggregate of some kind whose Expansion_Delayed
-- flag is set (see sinfo for meaning of flag). -- flag is set (see sinfo for meaning of flag).
procedure Convert_Aggr_In_Object_Decl (N : Node_Id); procedure Convert_Aggr_In_Object_Decl (N : Node_Id);
-- N is a N_Object_Declaration with an expression which must be -- N is a N_Object_Declaration with an expression which must be an
-- an N_Aggregate or N_Extension_Aggregate with Expansion_Delayed -- N_Aggregate or N_Extension_Aggregate with Expansion_Delayed.
-- This procedure performs in-place aggregate assignment. -- This procedure performs in-place aggregate assignment.
procedure Convert_Aggr_In_Allocator 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))); Rewrite (Exp, New_Copy (Expression (Exp)));
end if; end if;
else else
-- First check against the type of the qualified expression -- If we have:
-- -- type A is access T1;
-- NOTE: The commented call should be correct, but for some reason -- X : A := new T2'(...);
-- causes the compiler to bomb (sigsegv) on ACVC test c34007g, so for -- T1 and T2 can be different subtypes, and we might need to check
-- now we just perform the old (incorrect) test against the -- both constraints. First check against the type of the qualified
-- designated subtype with no sliding in the else part of the if -- expression.
-- statement below. ???
-- Apply_Constraint_Check (Exp, T, No_Sliding => True);
-- Apply_Constraint_Check (Exp, T, No_Sliding => True);
-- A check is also needed in cases where the designated subtype is -- A check is also needed in cases where the designated subtype is
-- constrained and differs from the subtype given in the qualified -- constrained and differs from the subtype given in the qualified
@ -997,14 +996,6 @@ package body Exp_Ch4 is
then then
Apply_Constraint_Check Apply_Constraint_Check
(Exp, DesigT, No_Sliding => False); (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; end if;
-- For an access to unconstrained packed array, GIGI needs to see an -- 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) -- (See Wrap_Transient_Expression for details)
-- 3. In a expression of an object_declaration. No wrapping is possible -- 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 -- declaration and the secondary stack deallocation is done in the
-- proper enclosing scope (see Wrap_Transient_Declaration for details) -- 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 -- always allocate their result in the secondary stack, even though is not
-- absolutely mandatory when the tagged type is constrained because the -- absolutely mandatory when the tagged type is constrained because the
-- caller knows the size of the returned object and thus could allocate 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; 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 -- N is a node which may generate a transient scope. Loop over the parent
-- parent pointers of N until it find the appropriate node to -- pointers of N until it find the appropriate node to wrap. If it returns
-- wrap. It it returns Empty, it means that no transient scope is -- Empty, it means that no transient scope is needed in this context.
-- needed in this context.
function Make_Clean function Make_Clean
(N : Node_Id; (N : Node_Id;
@ -158,14 +157,14 @@ package body Exp_Ch7 is
procedure Insert_Actions_In_Scope_Around (N : Node_Id); procedure Insert_Actions_In_Scope_Around (N : Node_Id);
-- Insert the before-actions kept in the scope stack before N, and the -- 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 function Make_Transient_Block
(Loc : Source_Ptr; (Loc : Source_Ptr;
Action : Node_Id) return Node_Id; Action : Node_Id) return Node_Id;
-- Create a transient block whose name is Scope, which is also a -- Create a transient block whose name is Scope, which is also a controlled
-- controlled block if Flist is not empty and whose only code is -- block if Flist is not empty and whose only code is Action (either a
-- Action (either a single statement or single declaration). -- single statement or single declaration).
type Final_Primitives is (Initialize_Case, Adjust_Case, Finalize_Case); type Final_Primitives is (Initialize_Case, Adjust_Case, Finalize_Case);
-- This enumeration type is defined in order to ease sharing code for -- This enumeration type is defined in order to ease sharing code for
@ -193,26 +192,24 @@ package body Exp_Ch7 is
(Prim : Final_Primitives; (Prim : Final_Primitives;
Typ : Entity_Id; Typ : Entity_Id;
Stmts : List_Id) return Node_Id; Stmts : List_Id) return Node_Id;
-- This function generates the tree for Deep_Initialize, Deep_Adjust -- This function generates the tree for Deep_Initialize, Deep_Adjust or
-- or Deep_Finalize procedures according to the first parameter, -- Deep_Finalize procedures according to the first parameter, these
-- these procedures operate on the type Typ. The Stmts parameter -- procedures operate on the type Typ. The Stmts parameter gives the body
-- gives the body of the procedure. -- of the procedure.
function Make_Deep_Array_Body function Make_Deep_Array_Body
(Prim : Final_Primitives; (Prim : Final_Primitives;
Typ : Entity_Id) return List_Id; Typ : Entity_Id) return List_Id;
-- This function generates the list of statements for implementing -- This function generates the list of statements for implementing
-- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures -- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures according to
-- according to the first parameter, these procedures operate on the -- the first parameter, these procedures operate on the array type Typ.
-- array type Typ.
function Make_Deep_Record_Body function Make_Deep_Record_Body
(Prim : Final_Primitives; (Prim : Final_Primitives;
Typ : Entity_Id) return List_Id; Typ : Entity_Id) return List_Id;
-- This function generates the list of statements for implementing -- This function generates the list of statements for implementing
-- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures -- Deep_Initialize, Deep_Adjust or Deep_Finalize procedures according to
-- according to the first parameter, these procedures operate on the -- the first parameter, these procedures operate on the record type Typ.
-- record type Typ.
procedure Check_Visibly_Controlled procedure Check_Visibly_Controlled
(Prim : Final_Primitives; (Prim : Final_Primitives;

2
gcc/ada/sinfo.ads
View File

@ -976,7 +976,7 @@ package Sinfo is
-- Expansion_Delayed (Flag11-Sem) -- Expansion_Delayed (Flag11-Sem)
-- Set on aggregates and extension aggregates that need a top-down rather -- 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 -- up. For nested aggregates the expansion is delayed until the enclosing
-- aggregate itself is expanded, e.g. in the context of a declaration. To -- 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 -- 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 (')'); 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 | when E_Signed_Integer_Type |
E_Signed_Integer_Subtype | E_Signed_Integer_Subtype |
E_Modular_Integer_Subtype => E_Modular_Integer_Subtype |
E_Enumeration_Subtype =>
Write_Header (Ekind (Typ) = E_Signed_Integer_Type); Write_Header (Ekind (Typ) = E_Signed_Integer_Type);