diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0957668a94c..6d0d2a6ba73 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2009-04-17 Thomas Quinot + + * sinfo.ads, exp_aggr.adb, exp_aggr.ads: Minor reformatting + + * exp_ch7.adb: Minor reformatting + +2009-04-17 Bob Duff + + * 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 + + * sprint.adb (Write_Itype): Add handling of enumeration subtypes. + 2009-04-17 Ed Schonberg * exp_ch4.adb (Expand_Allocator_Expression): Apply constraint check to diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 6ea4ddc961f..22e44f4b74e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -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; diff --git a/gcc/ada/exp_aggr.ads b/gcc/ada/exp_aggr.ads index 0b024fc2b8d..5d14f1d5fe1 100644 --- a/gcc/ada/exp_aggr.ads +++ b/gcc/ada/exp_aggr.ads @@ -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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 5640e76e756..ef4dbc51989 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -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 diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index acd7887089d..dc606480453 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -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; diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 5a20bc7cf49..b87c917c44d 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -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 diff --git a/gcc/ada/sprint.adb b/gcc/ada/sprint.adb index 4d6041dc200..35ecce93fc9 100644 --- a/gcc/ada/sprint.adb +++ b/gcc/ada/sprint.adb @@ -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);