+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
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
-- 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);
-- 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.
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);
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.
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;
-- 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
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
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
-- (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
--------------------------------------------------
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;
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
(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;
-- 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
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);
projects / thirdparty / gcc.git / commitdiff
