Skip to content

R
riscv-gcc-1
Commit 3b9fa2df by Ed Schonberg Committed by Arnaud Charlet
Options

exp_aggr.adb (Build_Record_Aggr_Code): If there is an aggregate for a limited ancestor part... 

2007-12-06  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Build_Record_Aggr_Code): If there is an aggregate for a
	limited ancestor part, initialize controllers of enclosing record
	before expanding ancestor aggregate.
	(Gen_Assign): If a component of the aggregate is box-initialized, add
	code to call Initialize if the component is controlled, and explicit
	assignment of null if the component is an access type.

	Handle properly aggregates for limited types that appear in object
	declarations when the aggregate contains controlled values such as
	protected types.
	When expanding limited aggregates into individual components, do not
	call Adjust on controlled components that are limited.

From-SVN: r130828
parent 1937a0c4
Showing with 252 additions and 195 deletions
gcc/ada/exp_aggr.adb
...@@ -1063,9 +1063,17 @@ package body Exp_Aggr is ...@@ -1063,9 +1063,17 @@ package body Exp_Aggr is
-- Ada 2005 (AI-287): In case of default initialized component, call -- Ada 2005 (AI-287): In case of default initialized component, call
-- the initialization subprogram associated with the component type. -- the initialization subprogram associated with the component type.
-- If the component type is an access type, add an explicit null
-- assignment, because for the back-end there is an initialization
-- present for the whole aggregate, and no default initialization
-- will take place.
-- In addition, if the component type is controlled, we must call
-- its Initialize procedure explicitly, because there is no explicit
-- object creation that will invoke it otherwise.
if No (Expr) then if No (Expr) then
if Present (Base_Init_Proc (Etype (Ctype))) if Present (Base_Init_Proc (Base_Type (Ctype)))
or else Has_Task (Base_Type (Ctype)) or else Has_Task (Base_Type (Ctype))
then then
Append_List_To (L, Append_List_To (L,
...@@ -1073,15 +1081,30 @@ package body Exp_Aggr is ...@@ -1073,15 +1081,30 @@ package body Exp_Aggr is
Id_Ref => Indexed_Comp, Id_Ref => Indexed_Comp,
Typ => Ctype, Typ => Ctype,
With_Default_Init => True)); With_Default_Init => True));
elsif Is_Access_Type (Ctype) then
Append_To (L,
Make_Assignment_Statement (Loc,
Name => Indexed_Comp,
Expression => Make_Null (Loc)));
end if;
if Controlled_Type (Ctype) then
Append_List_To (L,
Make_Init_Call (
Ref => New_Copy_Tree (Indexed_Comp),
Typ => Ctype,
Flist_Ref => Find_Final_List (Current_Scope),
With_Attach => Make_Integer_Literal (Loc, 1)));
end if; end if;
else else
-- Now generate the assignment with no associated controlled -- Now generate the assignment with no associated controlled
-- actions since the target of the assignment may not have -- actions since the target of the assignment may not have been
-- been initialized, it is not possible to Finalize it as -- initialized, it is not possible to Finalize it as expected by
-- expected by normal controlled assignment. The rest of the -- normal controlled assignment. The rest of the controlled
-- controlled actions are done manually with the proper -- actions are done manually with the proper finalization list
-- finalization list coming from the context. -- coming from the context.
A := A :=
Make_OK_Assignment_Statement (Loc, Make_OK_Assignment_Statement (Loc,
...@@ -1092,7 +1115,7 @@ package body Exp_Aggr is ...@@ -1092,7 +1115,7 @@ package body Exp_Aggr is
Set_No_Ctrl_Actions (A); Set_No_Ctrl_Actions (A);
-- If this is an aggregate for an array of arrays, each -- If this is an aggregate for an array of arrays, each
-- subaggregate will be expanded as well, and even with -- sub-aggregate will be expanded as well, and even with
-- No_Ctrl_Actions the assignments of inner components will -- No_Ctrl_Actions the assignments of inner components will
-- require attachment in their assignments to temporaries. -- require attachment in their assignments to temporaries.
-- These temporaries must be finalized for each subaggregate, -- These temporaries must be finalized for each subaggregate,
...@@ -1115,8 +1138,8 @@ package body Exp_Aggr is ...@@ -1115,8 +1138,8 @@ package body Exp_Aggr is
Append_To (L, A); Append_To (L, A);
-- Adjust the tag if tagged (because of possible view -- Adjust the tag if tagged (because of possible view
-- conversions), unless compiling for the Java VM -- conversions), unless compiling for the Java VM where
-- where tags are implicit. -- tags are implicit.
if Present (Comp_Type) if Present (Comp_Type)
and then Is_Tagged_Type (Comp_Type) and then Is_Tagged_Type (Comp_Type)
...@@ -1153,6 +1176,7 @@ package body Exp_Aggr is ...@@ -1153,6 +1176,7 @@ package body Exp_Aggr is
if Present (Comp_Type) if Present (Comp_Type)
and then Controlled_Type (Comp_Type) and then Controlled_Type (Comp_Type)
and then not Is_Limited_Type (Comp_Type)
and then and then
(not Is_Array_Type (Comp_Type) (not Is_Array_Type (Comp_Type)
or else not Is_Controlled (Component_Type (Comp_Type)) or else not Is_Controlled (Component_Type (Comp_Type))
...@@ -1230,9 +1254,9 @@ package body Exp_Aggr is ...@@ -1230,9 +1254,9 @@ package body Exp_Aggr is
elsif Equal (L, H) then elsif Equal (L, H) then
return Gen_Assign (New_Copy_Tree (L), Expr); return Gen_Assign (New_Copy_Tree (L), Expr);
-- If H - L <= 2 then generate a sequence of assignments -- If H - L <= 2 then generate a sequence of assignments when we are
-- when we are processing the bottom most aggregate and it contains -- processing the bottom most aggregate and it contains scalar
-- scalar components. -- components.
elsif No (Next_Index (Index)) elsif No (Next_Index (Index))
and then Scalar_Comp and then Scalar_Comp
...@@ -1292,9 +1316,9 @@ package body Exp_Aggr is ...@@ -1292,9 +1316,9 @@ package body Exp_Aggr is
Iteration_Scheme => L_Iteration_Scheme, Iteration_Scheme => L_Iteration_Scheme,
Statements => L_Body)); Statements => L_Body));
-- A small optimization: if the aggregate is initialized with a -- A small optimization: if the aggregate is initialized with a box
-- box and the component type has no initialization procedure, -- and the component type has no initialization procedure, remove the
-- remove the useless empty loop. -- useless empty loop.
if Nkind (First (S)) = N_Loop_Statement if Nkind (First (S)) = N_Loop_Statement
and then Is_Empty_List (Statements (First (S))) and then Is_Empty_List (Statements (First (S)))
...@@ -1490,11 +1514,13 @@ package body Exp_Aggr is ...@@ -1490,11 +1514,13 @@ package body Exp_Aggr is
Make_Integer_Literal (Loc, Uint_0)))); Make_Integer_Literal (Loc, Uint_0))));
end if; end if;
-- We can skip this
-- STEP 1: Process component associations -- STEP 1: Process component associations
-- For those associations that may generate a loop, initialize -- For those associations that may generate a loop, initialize
-- Loop_Actions to collect inserted actions that may be crated. -- Loop_Actions to collect inserted actions that may be crated.
-- Skip this if no component associations
if No (Expressions (N)) then if No (Expressions (N)) then
-- STEP 1 (a): Sort the discrete choices -- STEP 1 (a): Sort the discrete choices
...@@ -1651,6 +1677,10 @@ package body Exp_Aggr is ...@@ -1651,6 +1677,10 @@ package body Exp_Aggr is
-- Build_Record_Aggr_Code -- -- Build_Record_Aggr_Code --
---------------------------- ----------------------------
----------------------------
-- Build_Record_Aggr_Code --
----------------------------
function Build_Record_Aggr_Code function Build_Record_Aggr_Code
(N : Node_Id; (N : Node_Id;
Typ : Entity_Id; Typ : Entity_Id;
...@@ -1673,10 +1703,11 @@ package body Exp_Aggr is ...@@ -1673,10 +1703,11 @@ package body Exp_Aggr is
Comp_Expr : Node_Id; Comp_Expr : Node_Id;
Expr_Q : Node_Id; Expr_Q : Node_Id;
Internal_Final_List : Node_Id; Internal_Final_List : Node_Id := Empty;
-- If this is an internal aggregate, the External_Final_List is an -- If this is an internal aggregate, the External_Final_List is an
-- expression for the controller record of the enclosing type. -- expression for the controller record of the enclosing type.
-- If the current aggregate has several controlled components, this -- If the current aggregate has several controlled components, this
-- expression will appear in several calls to attach to the finali- -- expression will appear in several calls to attach to the finali-
-- zation list, and it must not be shared. -- zation list, and it must not be shared.
...@@ -1693,15 +1724,15 @@ package body Exp_Aggr is ...@@ -1693,15 +1724,15 @@ package body Exp_Aggr is
-- after the first do nothing. -- after the first do nothing.
function Ancestor_Discriminant_Value (Disc : Entity_Id) return Node_Id; function Ancestor_Discriminant_Value (Disc : Entity_Id) return Node_Id;
-- Returns the value that the given discriminant of an ancestor -- Returns the value that the given discriminant of an ancestor type
-- type should receive (in the absence of a conflict with the -- should receive (in the absence of a conflict with the value provided
-- value provided by an ancestor part of an extension aggregate). -- by an ancestor part of an extension aggregate).
procedure Check_Ancestor_Discriminants (Anc_Typ : Entity_Id); procedure Check_Ancestor_Discriminants (Anc_Typ : Entity_Id);
-- Check that each of the discriminant values defined by the -- Check that each of the discriminant values defined by the ancestor
-- ancestor part of an extension aggregate match the corresponding -- part of an extension aggregate match the corresponding values
-- values provided by either an association of the aggregate or -- provided by either an association of the aggregate or by the
-- by the constraint imposed by a parent type (RM95-4.3.2(8)). -- constraint imposed by a parent type (RM95-4.3.2(8)).
function Compatible_Int_Bounds function Compatible_Int_Bounds
(Agg_Bounds : Node_Id; (Agg_Bounds : Node_Id;
...@@ -1747,8 +1778,8 @@ package body Exp_Aggr is ...@@ -1747,8 +1778,8 @@ package body Exp_Aggr is
Save_Assoc : Node_Id := Empty; Save_Assoc : Node_Id := Empty;
begin begin
-- First check any discriminant associations to see if -- First check any discriminant associations to see if any of them
-- any of them provide a value for the discriminant. -- provide a value for the discriminant.
if Present (Discriminant_Specifications (Parent (Current_Typ))) then if Present (Discriminant_Specifications (Parent (Current_Typ))) then
Assoc := First (Component_Associations (N)); Assoc := First (Component_Associations (N));
...@@ -1760,9 +1791,10 @@ package body Exp_Aggr is ...@@ -1760,9 +1791,10 @@ package body Exp_Aggr is
Corresp_Disc := Corresponding_Discriminant (Aggr_Comp); Corresp_Disc := Corresponding_Discriminant (Aggr_Comp);
while Present (Corresp_Disc) loop while Present (Corresp_Disc) loop
-- If found a corresponding discriminant then return
-- the value given in the aggregate. (Note: this is -- If found a corresponding discriminant then return the
-- not correct in the presence of side effects. ???) -- value given in the aggregate. (Note: this is not
-- correct in the presence of side effects. ???)
if Disc = Corresp_Disc then if Disc = Corresp_Disc then
return Duplicate_Subexpr (Expression (Assoc)); return Duplicate_Subexpr (Expression (Assoc));
...@@ -1818,13 +1850,13 @@ package body Exp_Aggr is ...@@ -1818,13 +1850,13 @@ package body Exp_Aggr is
Assoc := Expression (Assoc); Assoc := Expression (Assoc);
end if; end if;
-- If the located association directly denotes -- If the located association directly denotes a
-- a discriminant, then use the value of a saved -- discriminant, then use the value of a saved
-- association of the aggregate. This is a kludge -- association of the aggregate. This is a kludge to
-- to handle certain cases involving multiple -- handle certain cases involving multiple discriminants
-- discriminants mapped to a single discriminant -- mapped to a single discriminant of a descendant. It's
-- of a descendant. It's not clear how to locate the -- not clear how to locate the appropriate discriminant
-- appropriate discriminant value for such cases. ??? -- value for such cases. ???
if Is_Entity_Name (Assoc) if Is_Entity_Name (Assoc)
and then Ekind (Entity (Assoc)) = E_Discriminant and then Ekind (Entity (Assoc)) = E_Discriminant
...@@ -2141,7 +2173,7 @@ package body Exp_Aggr is ...@@ -2141,7 +2173,7 @@ package body Exp_Aggr is
end if; end if;
-- In the Has_Controlled component case, all the intermediate -- In the Has_Controlled component case, all the intermediate
-- controllers must be initialized -- controllers must be initialized.
if Has_Controlled_Component (Typ) if Has_Controlled_Component (Typ)
and not Is_Limited_Ancestor_Expansion and not Is_Limited_Ancestor_Expansion
...@@ -2328,8 +2360,8 @@ package body Exp_Aggr is ...@@ -2328,8 +2360,8 @@ package body Exp_Aggr is
Target := Lhs; Target := Lhs;
end if; end if;
-- Deal with the ancestor part of extension aggregates -- Deal with the ancestor part of extension aggregates or with the
-- or with the discriminants of the root type -- discriminants of the root type.
if Nkind (N) = N_Extension_Aggregate then if Nkind (N) = N_Extension_Aggregate then
declare declare
...@@ -2349,12 +2381,12 @@ package body Exp_Aggr is ...@@ -2349,12 +2381,12 @@ package body Exp_Aggr is
if Is_Constrained (Entity (A)) then if Is_Constrained (Entity (A)) then
Init_Typ := Entity (A); Init_Typ := Entity (A);
-- For an ancestor part given by an unconstrained type -- For an ancestor part given by an unconstrained type mark,
-- mark, create a subtype constrained by appropriate -- create a subtype constrained by appropriate corresponding
-- corresponding discriminant values coming from either -- discriminant values coming from either associations of the
-- associations of the aggregate or a constraint on -- aggregate or a constraint on a parent type. The subtype will
-- a parent type. The subtype will be used to generate -- be used to generate the correct default value for the
-- the correct default value for the ancestor part. -- ancestor part.
elsif Has_Discriminants (Entity (A)) then elsif Has_Discriminants (Entity (A)) then
declare declare
...@@ -2387,9 +2419,9 @@ package body Exp_Aggr is ...@@ -2387,9 +2419,9 @@ package body Exp_Aggr is
Defining_Identifier => Init_Typ, Defining_Identifier => Init_Typ,
Subtype_Indication => New_Indic); Subtype_Indication => New_Indic);
-- Itypes must be analyzed with checks off -- Itypes must be analyzed with checks off Declaration
-- Declaration must have a parent for proper -- must have a parent for proper handling of subsidiary
-- handling of subsidiary actions. -- actions.
Set_Parent (Subt_Decl, N); Set_Parent (Subt_Decl, N);
Analyze (Subt_Decl, Suppress => All_Checks); Analyze (Subt_Decl, Suppress => All_Checks);
...@@ -2437,6 +2469,12 @@ package body Exp_Aggr is ...@@ -2437,6 +2469,12 @@ package body Exp_Aggr is
then then
Ancestor_Is_Expression := True; Ancestor_Is_Expression := True;
-- Set up finalization data for enclosing record, because
-- controlled subcomponents of the ancestor part will be
-- attached to it.
Gen_Ctrl_Actions_For_Aggr;
Append_List_To (L, Append_List_To (L,
Build_Record_Aggr_Code ( Build_Record_Aggr_Code (
N => Unqualify (A), N => Unqualify (A),
...@@ -2447,10 +2485,12 @@ package body Exp_Aggr is ...@@ -2447,10 +2485,12 @@ package body Exp_Aggr is
Is_Limited_Ancestor_Expansion => True)); Is_Limited_Ancestor_Expansion => True));
-- If the ancestor part is an expression "E", we generate -- If the ancestor part is an expression "E", we generate
-- T(tmp) := E; -- T(tmp) := E;
-- In Ada 2005, this includes the case of a (possibly qualified) -- In Ada 2005, this includes the case of a (possibly qualified)
-- limited function call. The assignment will turn into a -- limited function call. The assignment will turn into a
-- build-in-place function call (see -- build-in-place function call (for further details, see
-- Make_Build_In_Place_Call_In_Assignment). -- Make_Build_In_Place_Call_In_Assignment).
else else
...@@ -2521,7 +2561,9 @@ package body Exp_Aggr is ...@@ -2521,7 +2561,9 @@ package body Exp_Aggr is
-- Call Adjust manually -- Call Adjust manually
if Controlled_Type (Etype (A)) then if Controlled_Type (Etype (A))
and then not Is_Limited_Type (Etype (A))
then
Append_List_To (Assign, Append_List_To (Assign,
Make_Adjust_Call ( Make_Adjust_Call (
Ref => New_Copy_Tree (Ref), Ref => New_Copy_Tree (Ref),
...@@ -2649,7 +2691,7 @@ package body Exp_Aggr is ...@@ -2649,7 +2691,7 @@ package body Exp_Aggr is
while Present (Comp) loop while Present (Comp) loop
Selector := Entity (First (Choices (Comp))); Selector := Entity (First (Choices (Comp)));
-- Ada 2005 (AI-287): For each default-initialized component genarate -- Ada 2005 (AI-287): For each default-initialized component generate
-- a call to the corresponding IP subprogram if available. -- a call to the corresponding IP subprogram if available.
if Box_Present (Comp) if Box_Present (Comp)
...@@ -2705,6 +2747,7 @@ package body Exp_Aggr is ...@@ -2705,6 +2747,7 @@ package body Exp_Aggr is
or else Nkind (N) = N_Extension_Aggregate or else Nkind (N) = N_Extension_Aggregate
then then
-- All the discriminants have now been assigned -- All the discriminants have now been assigned
-- This is now a good moment to initialize and attach all the -- This is now a good moment to initialize and attach all the
-- controllers. Their position may depend on the discriminants. -- controllers. Their position may depend on the discriminants.
...@@ -2724,8 +2767,8 @@ package body Exp_Aggr is ...@@ -2724,8 +2767,8 @@ package body Exp_Aggr is
Expr_Q := Expression (Comp); Expr_Q := Expression (Comp);
end if; end if;
-- The controller is the one of the parent type defining -- The controller is the one of the parent type defining the
-- the component (in case of inherited components). -- component (in case of inherited components).
if Controlled_Type (Comp_Type) then if Controlled_Type (Comp_Type) then
Internal_Final_List := Internal_Final_List :=
...@@ -2758,11 +2801,11 @@ package body Exp_Aggr is ...@@ -2758,11 +2801,11 @@ package body Exp_Aggr is
-- an object declaration: -- an object declaration:
-- type Arr_Typ is array (Integer range <>) of ...; -- type Arr_Typ is array (Integer range <>) of ...;
--
-- type Rec_Typ (...) is record -- type Rec_Typ (...) is record
-- Obj_Arr_Typ : Arr_Typ (A .. B); -- Obj_Arr_Typ : Arr_Typ (A .. B);
-- end record; -- end record;
--
-- Obj_Rec_Typ : Rec_Typ := (..., -- Obj_Rec_Typ : Rec_Typ := (...,
-- Obj_Arr_Typ => (X => (...), Y => (...))); -- Obj_Arr_Typ => (X => (...), Y => (...)));
...@@ -2895,11 +2938,14 @@ package body Exp_Aggr is ...@@ -2895,11 +2938,14 @@ package body Exp_Aggr is
end if; end if;
-- Adjust and Attach the component to the proper controller -- Adjust and Attach the component to the proper controller
-- Adjust (tmp.comp); -- Adjust (tmp.comp);
-- Attach_To_Final_List (tmp.comp, -- Attach_To_Final_List (tmp.comp,
-- comp_typ (tmp)._record_controller.f) -- comp_typ (tmp)._record_controller.f)
if Controlled_Type (Comp_Type) then if Controlled_Type (Comp_Type)
and then not Is_Limited_Type (Comp_Type)
then
Append_List_To (L, Append_List_To (L,
Make_Adjust_Call ( Make_Adjust_Call (
Ref => New_Copy_Tree (Comp_Expr), Ref => New_Copy_Tree (Comp_Expr),
...@@ -2952,8 +2998,8 @@ package body Exp_Aggr is ...@@ -2952,8 +2998,8 @@ package body Exp_Aggr is
Reason => CE_Discriminant_Check_Failed)); Reason => CE_Discriminant_Check_Failed));
else else
-- Find self-reference in previous discriminant -- Find self-reference in previous discriminant assignment,
-- assignment, and replace with proper expression. -- and replace with proper expression.
declare declare
Ass : Node_Id; Ass : Node_Id;
...@@ -3092,8 +3138,8 @@ package body Exp_Aggr is ...@@ -3092,8 +3138,8 @@ package body Exp_Aggr is
Flist, Flist,
Associated_Final_Chain (Base_Type (Access_Type))); Associated_Final_Chain (Base_Type (Access_Type)));
-- ??? Dubious actual for Obj: expect 'the original object -- ??? Dubious actual for Obj: expect 'the original object being
-- being initialized' -- initialized'
if Has_Task (Typ) then if Has_Task (Typ) then
Build_Task_Allocate_Block_With_Init_Stmts (L, Aggr, Init_Stmts); Build_Task_Allocate_Block_With_Init_Stmts (L, Aggr, Init_Stmts);
...@@ -3109,8 +3155,8 @@ package body Exp_Aggr is ...@@ -3109,8 +3155,8 @@ package body Exp_Aggr is
(Aggr, Typ, Occ, Flist, (Aggr, Typ, Occ, Flist,
Associated_Final_Chain (Base_Type (Access_Type)))); Associated_Final_Chain (Base_Type (Access_Type))));
-- ??? Dubious actual for Obj: expect 'the original object -- ??? Dubious actual for Obj: expect 'the original object being
-- being initialized' -- initialized'
end if; end if;
end Convert_Aggr_In_Allocator; end Convert_Aggr_In_Allocator;
...@@ -3120,9 +3166,9 @@ package body Exp_Aggr is ...@@ -3120,9 +3166,9 @@ package body Exp_Aggr is
-------------------------------- --------------------------------
procedure Convert_Aggr_In_Assignment (N : Node_Id) is procedure Convert_Aggr_In_Assignment (N : Node_Id) is
Aggr : Node_Id := Expression (N); Aggr : Node_Id := Expression (N);
Typ : constant Entity_Id := Etype (Aggr); Typ : constant Entity_Id := Etype (Aggr);
Occ : constant Node_Id := New_Copy_Tree (Name (N)); Occ : constant Node_Id := New_Copy_Tree (Name (N));
begin begin
if Nkind (Aggr) = N_Qualified_Expression then if Nkind (Aggr) = N_Qualified_Expression then
...@@ -3237,8 +3283,13 @@ package body Exp_Aggr is ...@@ -3237,8 +3283,13 @@ package body Exp_Aggr is
-- the finalization list of the return must be moved to the caller's -- the finalization list of the return must be moved to the caller's
-- finalization list to complete the return. -- finalization list to complete the return.
-- However, if the aggregate is limited, it is built in place, and the
-- controlled components are not assigned to intermediate temporaries
-- so there is no need for a transient scope in this case either.
if Requires_Transient_Scope (Typ) if Requires_Transient_Scope (Typ)
and then Ekind (Current_Scope) /= E_Return_Statement and then Ekind (Current_Scope) /= E_Return_Statement
and then not Is_Limited_Type (Typ)
then then
Establish_Transient_Scope (Aggr, Sec_Stack => Establish_Transient_Scope (Aggr, Sec_Stack =>
Is_Controlled (Typ) or else Has_Controlled_Component (Typ)); Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
...@@ -3250,7 +3301,7 @@ package body Exp_Aggr is ...@@ -3250,7 +3301,7 @@ package body Exp_Aggr is
end Convert_Aggr_In_Object_Decl; end Convert_Aggr_In_Object_Decl;
------------------------------------- -------------------------------------
-- Convert_array_Aggr_In_Allocator -- -- Convert_Array_Aggr_In_Allocator --
------------------------------------- -------------------------------------
procedure Convert_Array_Aggr_In_Allocator procedure Convert_Array_Aggr_In_Allocator
...@@ -3319,8 +3370,8 @@ package body Exp_Aggr is ...@@ -3319,8 +3370,8 @@ package body Exp_Aggr is
end; end;
end if; end if;
-- Just set the Delay flag in the cases where the transformation -- Just set the Delay flag in the cases where the transformation will be
-- will be done top down from above. -- done top down from above.
if False if False
...@@ -3356,37 +3407,50 @@ package body Exp_Aggr is ...@@ -3356,37 +3407,50 @@ package body Exp_Aggr is
-- in place within the caller's scope). -- in place within the caller's scope).
or else or else
(Is_Inherently_Limited_Type (Typ) (Is_Inherently_Limited_Type (Typ)
and then and then
(Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement (Nkind (Parent (Parent_Node)) = N_Extended_Return_Statement
or else Nkind (Parent_Node) = N_Simple_Return_Statement)) or else Nkind (Parent_Node) = N_Simple_Return_Statement))
then then
Set_Expansion_Delayed (N); Set_Expansion_Delayed (N);
return; return;
end if; end if;
if Requires_Transient_Scope (Typ) then if Requires_Transient_Scope (Typ) then
Establish_Transient_Scope (N, Sec_Stack => Establish_Transient_Scope
Is_Controlled (Typ) or else Has_Controlled_Component (Typ)); (N, Sec_Stack =>
Is_Controlled (Typ) or else Has_Controlled_Component (Typ));
end if; end if;
-- Create the temporary -- If the aggregate is non-limited, create a temporary. If it is
-- limited and the context is an assignment, this is a subaggregate
Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('A')); -- for an enclosing aggregate being expanded. It must be built in place,
-- so use the target of the current assignment.
Instr := if Is_Limited_Type (Typ)
Make_Object_Declaration (Loc, and then Nkind (Parent (N)) = N_Assignment_Statement
Defining_Identifier => Temp, then
Object_Definition => New_Occurrence_Of (Typ, Loc)); Target_Expr := New_Copy_Tree (Name (Parent (N)));
Insert_Actions
(Parent (N), Build_Record_Aggr_Code (N, Typ, Target_Expr));
Rewrite (Parent (N), Make_Null_Statement (Loc));
Set_No_Initialization (Instr); else
Insert_Action (N, Instr); Temp := Make_Defining_Identifier (Loc, New_Internal_Name ('A'));
Initialize_Discriminants (Instr, Typ);
Target_Expr := New_Occurrence_Of (Temp, Loc);
Insert_Actions (N, Build_Record_Aggr_Code (N, Typ, Target_Expr)); Instr :=
Rewrite (N, New_Occurrence_Of (Temp, Loc)); Make_Object_Declaration (Loc,
Analyze_And_Resolve (N, Typ); Defining_Identifier => Temp,
Object_Definition => New_Occurrence_Of (Typ, Loc));
Set_No_Initialization (Instr);
Insert_Action (N, Instr);
Initialize_Discriminants (Instr, Typ);
Target_Expr := New_Occurrence_Of (Temp, Loc);
Insert_Actions (N, Build_Record_Aggr_Code (N, Typ, Target_Expr));
Rewrite (N, New_Occurrence_Of (Temp, Loc));
Analyze_And_Resolve (N, Typ);
end if;
end Convert_To_Assignments; end Convert_To_Assignments;
--------------------------- ---------------------------
...@@ -3403,21 +3467,21 @@ package body Exp_Aggr is ...@@ -3403,21 +3467,21 @@ package body Exp_Aggr is
Static_Components : Boolean := True; Static_Components : Boolean := True;
procedure Check_Static_Components; procedure Check_Static_Components;
-- Check whether all components of the aggregate are compile-time -- Check whether all components of the aggregate are compile-time known
-- known values, and can be passed as is to the back-end without -- values, and can be passed as is to the back-end without further
-- further expansion. -- expansion.
function Flatten function Flatten
(N : Node_Id; (N : Node_Id;
Ix : Node_Id; Ix : Node_Id;
Ixb : Node_Id) return Boolean; Ixb : Node_Id) return Boolean;
-- Convert the aggregate into a purely positional form if possible. -- Convert the aggregate into a purely positional form if possible. On
-- On entry the bounds of all dimensions are known to be static, -- entry the bounds of all dimensions are known to be static, and the
-- and the total number of components is safe enough to expand. -- total number of components is safe enough to expand.
function Is_Flat (N : Node_Id; Dims : Int) return Boolean; function Is_Flat (N : Node_Id; Dims : Int) return Boolean;
-- Return True iff the array N is flat (which is not rivial -- Return True iff the array N is flat (which is not rivial in the case
-- in the case of multidimensionsl aggregates). -- of multidimensionsl aggregates).
----------------------------- -----------------------------
-- Check_Static_Components -- -- Check_Static_Components --
...@@ -3505,8 +3569,8 @@ package body Exp_Aggr is ...@@ -3505,8 +3569,8 @@ package body Exp_Aggr is
return False; return False;
end if; end if;
-- Determine if set of alternatives is suitable for conversion -- Determine if set of alternatives is suitable for conversion and
-- and build an array containing the values in sequence. -- build an array containing the values in sequence.
declare declare
Vals : array (UI_To_Int (Lov) .. UI_To_Int (Hiv)) Vals : array (UI_To_Int (Lov) .. UI_To_Int (Hiv))
...@@ -3723,8 +3787,8 @@ package body Exp_Aggr is ...@@ -3723,8 +3787,8 @@ package body Exp_Aggr is
return; return;
end if; end if;
-- Do not convert to positional if controlled components are -- Do not convert to positional if controlled components are involved
-- involved since these require special processing -- since these require special processing
if Has_Controlled_Component (Typ) then if Has_Controlled_Component (Typ) then
return; return;
...@@ -3900,10 +3964,10 @@ package body Exp_Aggr is ...@@ -3900,10 +3964,10 @@ package body Exp_Aggr is
end loop; end loop;
else else
-- We know the aggregate type is unconstrained and the -- We know the aggregate type is unconstrained and the aggregate
-- aggregate is not processable by the back end, therefore -- is not processable by the back end, therefore not necessarily
-- not necessarily positional. Retrieve the bounds of each -- positional. Retrieve each dimension bounds (computed earlier).
-- dimension as computed earlier. -- earlier.
for D in 1 .. Number_Dimensions (Typ) loop for D in 1 .. Number_Dimensions (Typ) loop
Append ( Append (
...@@ -3955,7 +4019,7 @@ package body Exp_Aggr is ...@@ -3955,7 +4019,7 @@ package body Exp_Aggr is
-- [constraint_error when -- [constraint_error when
-- Aggr_Lo <= Aggr_Hi and then -- Aggr_Lo <= Aggr_Hi and then
-- (Aggr_Lo < Ind_Lo or else Aggr_Hi > Ind_Hi)] -- (Aggr_Lo < Ind_Lo or else Aggr_Hi > Ind_Hi)]
--
-- As an optimization try to see if some tests are trivially vacuos -- As an optimization try to see if some tests are trivially vacuos
-- because we are comparing an expression against itself. -- because we are comparing an expression against itself.
...@@ -4024,16 +4088,15 @@ package body Exp_Aggr is ...@@ -4024,16 +4088,15 @@ package body Exp_Aggr is
-- The index type for this dimension.xxx -- The index type for this dimension.xxx
Cond : Node_Id := Empty; Cond : Node_Id := Empty;
Assoc : Node_Id; Assoc : Node_Id;
Expr : Node_Id; Expr : Node_Id;
begin begin
-- If index checks are on generate the test -- If index checks are on generate the test
--
-- [constraint_error when -- [constraint_error when
-- Aggr_Lo /= Sub_Lo or else Aggr_Hi /= Sub_Hi] -- Aggr_Lo /= Sub_Lo or else Aggr_Hi /= Sub_Hi]
--
-- As an optimization try to see if some tests are trivially vacuos -- As an optimization try to see if some tests are trivially vacuos
-- because we are comparing an expression against itself. Also for -- because we are comparing an expression against itself. Also for
-- the first dimension the test is trivially vacuous because there -- the first dimension the test is trivially vacuous because there
...@@ -4193,7 +4256,7 @@ package body Exp_Aggr is ...@@ -4193,7 +4256,7 @@ package body Exp_Aggr is
Obj_Hi : Node_Id; Obj_Hi : Node_Id;
function Is_Others_Aggregate (Aggr : Node_Id) return Boolean; function Is_Others_Aggregate (Aggr : Node_Id) return Boolean;
-- Aggregates that consist of a single Others choice are safe -- Aggregates that consist of a single Others choice are safe
-- if the single expression is. -- if the single expression is.
function Safe_Aggregate (Aggr : Node_Id) return Boolean; function Safe_Aggregate (Aggr : Node_Id) return Boolean;
...@@ -4446,8 +4509,8 @@ package body Exp_Aggr is ...@@ -4446,8 +4509,8 @@ package body Exp_Aggr is
Need_To_Check := False; Need_To_Check := False;
else else
-- Count the number of discrete choices. Start with -1 -- Count the number of discrete choices. Start with -1 because
-- because the others choice does not count. -- the others choice does not count.
Nb_Choices := -1; Nb_Choices := -1;
Assoc := First (Component_Associations (Sub_Aggr)); Assoc := First (Component_Associations (Sub_Aggr));
...@@ -4470,8 +4533,8 @@ package body Exp_Aggr is ...@@ -4470,8 +4533,8 @@ package body Exp_Aggr is
Need_To_Check := False; Need_To_Check := False;
end if; end if;
-- If we are dealing with a positional sub-aggregate with an -- If we are dealing with a positional sub-aggregate with an others
-- others choice then compute the number or positional elements. -- choice then compute the number or positional elements.
if Need_To_Check and then Present (Expressions (Sub_Aggr)) then if Need_To_Check and then Present (Expressions (Sub_Aggr)) then
Expr := First (Expressions (Sub_Aggr)); Expr := First (Expressions (Sub_Aggr));
...@@ -4529,9 +4592,9 @@ package body Exp_Aggr is ...@@ -4529,9 +4592,9 @@ package body Exp_Aggr is
if not Need_To_Check then if not Need_To_Check then
Cond := Empty; Cond := Empty;
-- If we are dealing with an aggregate containing an others -- If we are dealing with an aggregate containing an others choice
-- choice and positional components, we generate the following test: -- and positional components, we generate the following test:
--
-- if Ind_Typ'Pos (Aggr_Lo) + (Nb_Elements - 1) > -- if Ind_Typ'Pos (Aggr_Lo) + (Nb_Elements - 1) >
-- Ind_Typ'Pos (Aggr_Hi) -- Ind_Typ'Pos (Aggr_Hi)
-- then -- then
...@@ -4559,9 +4622,9 @@ package body Exp_Aggr is ...@@ -4559,9 +4622,9 @@ package body Exp_Aggr is
Expressions => New_List ( Expressions => New_List (
Duplicate_Subexpr_Move_Checks (Aggr_Hi)))); Duplicate_Subexpr_Move_Checks (Aggr_Hi))));
-- If we are dealing with an aggregate containing an others -- If we are dealing with an aggregate containing an others choice
-- choice and discrete choices we generate the following test: -- and discrete choices we generate the following test:
--
-- [constraint_error when -- [constraint_error when
-- Choices_Lo < Aggr_Lo or else Choices_Hi > Aggr_Hi]; -- Choices_Lo < Aggr_Lo or else Choices_Hi > Aggr_Hi];
...@@ -4674,16 +4737,16 @@ package body Exp_Aggr is ...@@ -4674,16 +4737,16 @@ package body Exp_Aggr is
if not Range_Checks_Suppressed (Etype (Index_Constraint)) if not Range_Checks_Suppressed (Etype (Index_Constraint))
and then not Others_Present (J) and then not Others_Present (J)
then then
-- We don't use Checks.Apply_Range_Check here because it -- We don't use Checks.Apply_Range_Check here because it emits
-- emits a spurious check. Namely it checks that the range -- a spurious check. Namely it checks that the range defined by
-- defined by the aggregate bounds is non empty. But we know -- the aggregate bounds is non empty. But we know this already
-- this already if we get here. -- if we get here.
Check_Bounds (Aggr_Index_Range, Index_Constraint); Check_Bounds (Aggr_Index_Range, Index_Constraint);
end if; end if;
-- Save the low and high bounds of the aggregate index as well -- Save the low and high bounds of the aggregate index as well as
-- as the index type for later use in checks (b) and (c) below. -- the index type for later use in checks (b) and (c) below.
Aggr_Low (J) := Low_Bound (Aggr_Index_Range); Aggr_Low (J) := Low_Bound (Aggr_Index_Range);
Aggr_High (J) := High_Bound (Aggr_Index_Range); Aggr_High (J) := High_Bound (Aggr_Index_Range);
...@@ -4697,8 +4760,8 @@ package body Exp_Aggr is ...@@ -4697,8 +4760,8 @@ package body Exp_Aggr is
-- STEP 1b -- STEP 1b
-- If an others choice is present check that no aggregate -- If an others choice is present check that no aggregate index is
-- index is outside the bounds of the index constraint. -- outside the bounds of the index constraint.
Others_Check (N, 1); Others_Check (N, 1);
...@@ -4713,10 +4776,10 @@ package body Exp_Aggr is ...@@ -4713,10 +4776,10 @@ package body Exp_Aggr is
-- STEP 2 -- STEP 2
-- Here we test for is packed array aggregate that we can handle -- Here we test for is packed array aggregate that we can handle at
-- at compile time. If so, return with transformation done. Note -- compile time. If so, return with transformation done. Note that we do
-- that we do this even if the aggregate is nested, because once -- this even if the aggregate is nested, because once we have done this
-- we have done this processing, there is no more nested aggregate! -- processing, there is no more nested aggregate!
if Packed_Array_Aggregate_Handled (N) then if Packed_Array_Aggregate_Handled (N) then
return; return;
...@@ -5142,19 +5205,19 @@ package body Exp_Aggr is ...@@ -5142,19 +5205,19 @@ package body Exp_Aggr is
Expr_Q := Expression (C); Expr_Q := Expression (C);
end if; end if;
-- Return true if the aggregate has any associations for -- Return true if the aggregate has any associations for tagged
-- tagged components that may require tag adjustment. -- components that may require tag adjustment.
-- These are cases where the source expression may have
-- a tag that could differ from the component tag (e.g., -- These are cases where the source expression may have a tag that
-- can occur for type conversions and formal parameters). -- could differ from the component tag (e.g., can occur for type
-- (Tag adjustment is not needed if VM_Target because object -- conversions and formal parameters). (Tag adjustment not needed
-- tags are implicit in the JVM.) -- if VM_Target because object tags are implicit in the machine.)
if Is_Tagged_Type (Etype (Expr_Q)) if Is_Tagged_Type (Etype (Expr_Q))
and then (Nkind (Expr_Q) = N_Type_Conversion and then (Nkind (Expr_Q) = N_Type_Conversion
or else (Is_Entity_Name (Expr_Q) or else (Is_Entity_Name (Expr_Q)
and then and then
Ekind (Entity (Expr_Q)) in Formal_Kind)) Ekind (Entity (Expr_Q)) in Formal_Kind))
and then VM_Target = No_VM and then VM_Target = No_VM
then then
Static_Components := False; Static_Components := False;
...@@ -5264,8 +5327,7 @@ package body Exp_Aggr is ...@@ -5264,8 +5327,7 @@ package body Exp_Aggr is
Convert_To_Assignments (N, Typ); Convert_To_Assignments (N, Typ);
-- If the tagged types covers interface types we need to initialize all -- If the tagged types covers interface types we need to initialize all
-- the hidden components containing the pointers to secondary dispatch -- hidden components containing pointers to secondary dispatch tables.
-- tables.
elsif Is_Tagged_Type (Typ) and then Has_Abstract_Interfaces (Typ) then elsif Is_Tagged_Type (Typ) and then Has_Abstract_Interfaces (Typ) then
Convert_To_Assignments (N, Typ); Convert_To_Assignments (N, Typ);
...@@ -5278,20 +5340,19 @@ package body Exp_Aggr is ...@@ -5278,20 +5340,19 @@ package body Exp_Aggr is
elsif Has_Mutable_Components (Typ) then elsif Has_Mutable_Components (Typ) then
Convert_To_Assignments (N, Typ); Convert_To_Assignments (N, Typ);
-- If the type involved has any non-bit aligned components, then -- If the type involved has any non-bit aligned components, then we are
-- we are not sure that the back end can handle this case correctly. -- not sure that the back end can handle this case correctly.
elsif Type_May_Have_Bit_Aligned_Components (Typ) then elsif Type_May_Have_Bit_Aligned_Components (Typ) then
Convert_To_Assignments (N, Typ); Convert_To_Assignments (N, Typ);
-- In all other cases we generate a proper aggregate that -- In all other cases, build a proper aggregate handlable by gigi
-- can be handled by gigi.
else else
if Nkind (N) = N_Aggregate then if Nkind (N) = N_Aggregate then
-- If the aggregate is static and can be handled by the -- If the aggregate is static and can be handled by the back-end,
-- back-end, nothing left to do. -- nothing left to do.
if Static_Components then if Static_Components then
Set_Compile_Time_Known_Aggregate (N); Set_Compile_Time_Known_Aggregate (N);
...@@ -5321,8 +5382,8 @@ package body Exp_Aggr is ...@@ -5321,8 +5382,8 @@ package body Exp_Aggr is
Num_Gird : Int := 0; Num_Gird : Int := 0;
procedure Prepend_Stored_Values (T : Entity_Id); procedure Prepend_Stored_Values (T : Entity_Id);
-- Scan the list of stored discriminants of the type, and -- Scan the list of stored discriminants of the type, and add
-- add their values to the aggregate being built. -- their values to the aggregate being built.
--------------------------- ---------------------------
-- Prepend_Stored_Values -- -- Prepend_Stored_Values --
...@@ -5358,8 +5419,7 @@ package body Exp_Aggr is ...@@ -5358,8 +5419,7 @@ package body Exp_Aggr is
-- Start of processing for Generate_Aggregate_For_Derived_Type -- Start of processing for Generate_Aggregate_For_Derived_Type
begin begin
-- Remove the associations for the discriminant of -- Remove the associations for the discriminant of derived type
-- the derived type.
First_Comp := First (Component_Associations (N)); First_Comp := First (Component_Associations (N));
while Present (First_Comp) loop while Present (First_Comp) loop
...@@ -5376,10 +5436,10 @@ package body Exp_Aggr is ...@@ -5376,10 +5436,10 @@ package body Exp_Aggr is
-- Insert stored discriminant associations in the correct -- Insert stored discriminant associations in the correct
-- order. If there are more stored discriminants than new -- order. If there are more stored discriminants than new
-- discriminants, there is at least one new discriminant -- discriminants, there is at least one new discriminant that
-- that constrains more than one of the stored discriminants. -- constrains more than one of the stored discriminants. In
-- In this case we need to construct a proper subtype of -- this case we need to construct a proper subtype of the
-- the parent type, in order to supply values to all the -- parent type, in order to supply values to all the
-- components. Otherwise there is one-one correspondence -- components. Otherwise there is one-one correspondence
-- between the constraints and the stored discriminants. -- between the constraints and the stored discriminants.
...@@ -5395,9 +5455,9 @@ package body Exp_Aggr is ...@@ -5395,9 +5455,9 @@ package body Exp_Aggr is
if Num_Gird > Num_Disc then if Num_Gird > Num_Disc then
-- Create a proper subtype of the parent type, which is -- Create a proper subtype of the parent type, which is the
-- the proper implementation type for the aggregate, and -- proper implementation type for the aggregate, and convert
-- convert it to the intended target type. -- it to the intended target type.
Discriminant := First_Stored_Discriminant (Base_Type (Typ)); Discriminant := First_Stored_Discriminant (Base_Type (Typ));
while Present (Discriminant) loop while Present (Discriminant) loop
...@@ -5434,8 +5494,8 @@ package body Exp_Aggr is ...@@ -5434,8 +5494,8 @@ package body Exp_Aggr is
Analyze (N); Analyze (N);
-- Case where we do not have fewer new discriminants than -- Case where we do not have fewer new discriminants than
-- stored discriminants, so in this case we can simply -- stored discriminants, so in this case we can simply use the
-- use the stored discriminants of the subtype. -- stored discriminants of the subtype.
else else
Prepend_Stored_Values (Typ); Prepend_Stored_Values (Typ);
...@@ -5812,10 +5872,10 @@ package body Exp_Aggr is ...@@ -5812,10 +5872,10 @@ package body Exp_Aggr is
-- Values of bounds if compile time known -- Values of bounds if compile time known
function Get_Component_Val (N : Node_Id) return Uint; function Get_Component_Val (N : Node_Id) return Uint;
-- Given a expression value N of the component type Ctyp, returns -- Given a expression value N of the component type Ctyp, returns a
-- A value of Csiz (component size) bits representing this value. -- value of Csiz (component size) bits representing this value. If
-- If the value is non-static or any other reason exists why the -- the value is non-static or any other reason exists why the value
-- value cannot be returned, then Not_Handled is raised. -- cannot be returned, then Not_Handled is raised.
----------------------- -----------------------
-- Get_Component_Val -- -- Get_Component_Val --
...@@ -5831,9 +5891,9 @@ package body Exp_Aggr is ...@@ -5831,9 +5891,9 @@ package body Exp_Aggr is
Analyze_And_Resolve (N, Ctyp); Analyze_And_Resolve (N, Ctyp);
-- Must have a compile time value. String literals have to -- Must have a compile time value. String literals have to be
-- be converted into temporaries as well, because they cannot -- converted into temporaries as well, because they cannot easily
-- easily be converted into their bit representation. -- be converted into their bit representation.
if not Compile_Time_Known_Value (N) if not Compile_Time_Known_Value (N)
or else Nkind (N) = N_String_Literal or else Nkind (N) = N_String_Literal
...@@ -5878,18 +5938,17 @@ package body Exp_Aggr is ...@@ -5878,18 +5938,17 @@ package body Exp_Aggr is
return False; return False;
end if; end if;
-- At this stage we have a suitable aggregate for handling -- At this stage we have a suitable aggregate for handling at compile
-- at compile time (the only remaining checks, are that the -- time (the only remaining checks are that the values of expressions
-- values of expressions in the aggregate are compile time -- in the aggregate are compile time known (check is performed by
-- known (check performed by Get_Component_Val), and that -- Get_Component_Val), and that any subtypes or ranges are statically
-- any subtypes or ranges are statically known. -- known.
-- If the aggregate is not fully positional at this stage, -- If the aggregate is not fully positional at this stage, then
-- then convert it to positional form. Either this will fail, -- convert it to positional form. Either this will fail, in which
-- in which case we can do nothing, or it will succeed, in -- case we can do nothing, or it will succeed, in which case we have
-- which case we have succeeded in handling the aggregate, -- succeeded in handling the aggregate, or it will stay an aggregate,
-- or it will stay an aggregate, in which case we have failed -- in which case we have failed to handle this case.
-- to handle this case.
if Present (Component_Associations (N)) then if Present (Component_Associations (N)) then
Convert_To_Positional Convert_To_Positional
...@@ -5907,13 +5966,12 @@ package body Exp_Aggr is ...@@ -5907,13 +5966,12 @@ package body Exp_Aggr is
-- The length of the array (number of elements) -- The length of the array (number of elements)
Aggregate_Val : Uint; Aggregate_Val : Uint;
-- Value of aggregate. The value is set in the low order -- Value of aggregate. The value is set in the low order bits of
-- bits of this value. For the little-endian case, the -- this value. For the little-endian case, the values are stored
-- values are stored from low-order to high-order and -- from low-order to high-order and for the big-endian case the
-- for the big-endian case the values are stored from -- values are stored from high-order to low-order. Note that gigi
-- high-order to low-order. Note that gigi will take care -- will take care of the conversions to left justify the value in
-- of the conversions to left justify the value in the big -- the big endian case (because of left justified modular type
-- endian case (because of left justified modular type
-- processing), so we do not have to worry about that here. -- processing), so we do not have to worry about that here.
Lit : Node_Id; Lit : Node_Id;
...@@ -5929,10 +5987,9 @@ package body Exp_Aggr is ...@@ -5929,10 +5987,9 @@ package body Exp_Aggr is
-- Next expression from positional parameters of aggregate -- Next expression from positional parameters of aggregate
begin begin
-- For little endian, we fill up the low order bits of the -- For little endian, we fill up the low order bits of the target
-- target value. For big endian we fill up the high order -- value. For big endian we fill up the high order bits of the
-- bits of the target value (which is a left justified -- target value (which is a left justified modular value).
-- modular value).
if Bytes_Big_Endian xor Debug_Flag_8 then if Bytes_Big_Endian xor Debug_Flag_8 then
Shift := Csiz * (Len - 1); Shift := Csiz * (Len - 1);
...@@ -6054,9 +6111,9 @@ package body Exp_Aggr is ...@@ -6054,9 +6111,9 @@ package body Exp_Aggr is
is is
L1, L2, H1, H2 : Node_Id; L1, L2, H1, H2 : Node_Id;
begin begin
-- No sliding if the type of the object is not established yet, if -- No sliding if the type of the object is not established yet, if it is
-- it is an unconstrained type whose actual subtype comes from the -- an unconstrained type whose actual subtype comes from the aggregate,
-- aggregate, or if the two types are identical. -- or if the two types are identical.
if not Is_Array_Type (Obj_Type) then if not Is_Array_Type (Obj_Type) then
return False; return False;
...@@ -6242,8 +6299,8 @@ package body Exp_Aggr is ...@@ -6242,8 +6299,8 @@ package body Exp_Aggr is
return False; return False;
else else
-- The aggregate is static if all components are literals, -- The aggregate is static if all components are literals, or
-- or else all its components are static aggregates for the -- else all its components are static aggregates for the
-- component type. -- component type.
if Is_Array_Type (Comp_Type) if Is_Array_Type (Comp_Type)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment