diff options
author | Gary Dismukes <dismukes@adacore.com> | 2024-01-16 22:11:52 +0000 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-13 10:03:26 +0200 |
commit | 0a82463c573f5f75314c5700863b1fea822da1f9 (patch) | |
tree | b32182b139e8d04229069e8a34efcacad9ec22a9 | |
parent | 2d0eeb529d400e61197a09c56011be976dd81ef0 (diff) | |
download | gcc-0a82463c573f5f75314c5700863b1fea822da1f9.zip gcc-0a82463c573f5f75314c5700863b1fea822da1f9.tar.gz gcc-0a82463c573f5f75314c5700863b1fea822da1f9.tar.bz2 |
ada: Compiler crash on nonstatic container aggregates for Doubly_Linked_Lists
The compiler was crashing on container aggregates for the List type
coming from an instantiation of Ada.Containers.Doubly_Linked_Lists
when the aggregate has more than one iterated_element_association
with nonstatic range bounds. As part of addressing this, it was
noticed that there were also somewhat related problems with container
aggregates associated with the Ada.Containers.Bounded_Doubly_Linked_Lists
generic (and likely others like it) and mishandling of certain cases of
indexed aggregates, and those are also addressed by this set of changes.
In the case of container aggregates with at least one association with
a nonstatic range, the total length of the aggregate is determined by
expansion actions of Aggregate_Size.
gcc/ada/
* exp_aggr.adb (Expand_Container_Aggregate): Move determination of
whether the aggregate is an indexed aggregate earlier in the
procedure. Test Is_Indexed_Aggregate as a criterion for generating
a call to the container type's New_Indexed function, add proper
computation of bounds to pass in to the function, and remove later
code for generating such a call. Add and improve comments.
(Aggregate_Size): Remove special treatment of case where there is
exactly one component association, and instead loop over all
component associations to determine whether any of them have a
nonstatic length. If there is at least one such nonstatic
association, return -1.
(Build_Siz_Exp): Accumulate a sum of the sizes of each of the
component associations in Siz_Exp (which will only be used if
there any associations that are of Nkind
N_Iterated_Component_Association with a nonstatic range).
(Expand_Range_Component): Fix typos in the procedure's spec
comment and block comment.
-rw-r--r-- | gcc/ada/exp_aggr.adb | 247 |
1 files changed, 149 insertions, 98 deletions
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 950f310..c82bd07 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -6662,6 +6662,8 @@ package body Exp_Aggr is end if; end Add_Range_Size; + -- Start of processing for Aggregate_Size + begin -- Aggregate is either all positional or all named @@ -6669,23 +6671,39 @@ package body Exp_Aggr is if Present (Component_Associations (N)) then Comp := First (Component_Associations (N)); - -- If there is a single component association it can be - -- an iterated component with dynamic bounds or an element - -- iterator over an iterable object. If it is an array - -- we can use the attribute Length to get its size; - -- for a predefined container the function Length plays - -- the same role. There is no available mechanism for - -- user-defined containers. For now we treat all of these - -- as dynamic. - - if List_Length (Component_Associations (N)) = 1 - and then Nkind (Comp) in N_Iterated_Component_Association | - N_Iterated_Element_Association - then - return Build_Siz_Exp (Comp); - end if; - -- Otherwise all associations must specify static sizes. + -- If one or more of the associations is one of the iterated + -- forms, and is either an association with nonstatic bounds + -- or is an iterator over an iterable object, then treat the + -- whole container aggregate as having a nonstatic number of + -- elements. + + declare + Has_Nonstatic_Length : Boolean := False; + + begin + while Present (Comp) loop + if Nkind (Comp) in N_Iterated_Component_Association | + N_Iterated_Element_Association + and then Build_Siz_Exp (Comp) = -1 + then + Has_Nonstatic_Length := True; + end if; + + Next (Comp); + end loop; + + if Has_Nonstatic_Length then + return -1; + end if; + end; + + -- Otherwise, the aggregate must have associations where all + -- choices and bounds are statically known, and we compute + -- the number of elements statically by adding up the number + -- of elements in each association. + + Comp := First (Component_Associations (N)); while Present (Comp) loop Choice := First (Choice_List (Comp)); @@ -6731,7 +6749,9 @@ package body Exp_Aggr is ------------------- function Build_Siz_Exp (Comp : Node_Id) return Int is - Lo, Hi : Node_Id; + Lo, Hi : Node_Id; + Temp_Siz_Exp : Node_Id; + begin if Nkind (Comp) = N_Range then Lo := Low_Bound (Comp); @@ -6750,10 +6770,29 @@ package body Exp_Aggr is Siz := UI_To_Int (Enumeration_Pos (Hi)) - UI_To_Int (Enumeration_Pos (Lo)) + 1; end if; + + -- Include the static value in the computation of the aggregate + -- length in Siz_Exp. This will only end up being used if there + -- are one or more associations that have nonstatic ranges. + + if Present (Siz_Exp) then + Siz_Exp := Make_Op_Add (Sloc (Comp), + Left_Opnd => Siz_Exp, + Right_Opnd => Make_Integer_Literal (Loc, Siz)); + else + Siz_Exp := Make_Integer_Literal (Loc, Siz); + end if; + return Siz; + -- The possibility of having multiple associations with nonstatic + -- ranges (plus static ranges) means that in general we really + -- should be accumulating a sum of the various sizes. The current + -- code can end up overwriting Siz_Exp on subsequent associations + -- (plus won't account for associations with static ranges). ??? + else - Siz_Exp := + Temp_Siz_Exp := Make_Op_Add (Sloc (Comp), Left_Opnd => Make_Op_Subtract (Sloc (Comp), @@ -6761,6 +6800,18 @@ package body Exp_Aggr is Right_Opnd => New_Copy_Tree (Lo)), Right_Opnd => Make_Integer_Literal (Loc, 1)); + + -- Include this nonstatic length in the total length being + -- accumulated in Siz_Exp. + + if Present (Siz_Exp) then + Siz_Exp := Make_Op_Add (Sloc (Comp), + Left_Opnd => Siz_Exp, + Right_Opnd => Temp_Siz_Exp); + else + Siz_Exp := Temp_Siz_Exp; + end if; + return -1; end if; @@ -6914,6 +6965,37 @@ package body Exp_Aggr is Empty_Subp, Add_Named_Subp, Add_Unnamed_Subp, New_Indexed_Subp, Assign_Indexed_Subp); + -- Determine whether this is an indexed aggregate (see RM 4.3.5(25/5)) + + if Present (New_Indexed_Subp) then + if No (Add_Unnamed_Subp) then + Is_Indexed_Aggregate := True; + + else + declare + Comp_Assns : constant List_Id := Component_Associations (N); + Comp_Assn : Node_Id; + + begin + if not Is_Empty_List (Comp_Assns) then + + -- It suffices to look at the first association to determine + -- whether the aggregate is an indexed aggregate. + + Comp_Assn := First (Comp_Assns); + + if Nkind (Comp_Assn) = N_Component_Association + or else + (Nkind (Comp_Assn) = N_Iterated_Component_Association + and then Present (Defining_Identifier (Comp_Assn))) + then + Is_Indexed_Aggregate := True; + end if; + end if; + end; + end if; + end if; + -- The constructor for bounded containers is a function with -- a parameter that sets the size of the container. If the -- size cannot be determined statically we use a default value @@ -6963,7 +7045,48 @@ package body Exp_Aggr is Expression => Siz_Exp); Append (Siz_Decl, Aggr_Code); - if Nkind (Siz_Exp) = N_Integer_Literal then + -- In the case of an indexed aggregate, the aggregate is allocated + -- with the New_Indexed operation, passing the bounds. + + if Is_Indexed_Aggregate then + declare + Insert : constant Entity_Id := + Entity (Assign_Indexed_Subp); + Index_Type : constant Entity_Id := + Etype (Next_Formal (First_Formal (Insert))); + Index : Node_Id; + + begin + Index := Make_Op_Add (Loc, + Left_Opnd => New_Copy_Tree (Type_Low_Bound (Index_Type)), + Right_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => Make_Type_Conversion (Loc, + Subtype_Mark => + New_Occurrence_Of (Index_Type, Loc), + Expression => + New_Occurrence_Of + (Defining_Identifier (Siz_Decl), + Loc)), + Right_Opnd => Make_Integer_Literal (Loc, 1))); + + Init_Stat := + Make_Object_Declaration (Loc, + Defining_Identifier => Temp, + Object_Definition => New_Occurrence_Of (Typ, Loc), + Expression => Make_Function_Call (Loc, + Name => + New_Occurrence_Of (Entity (New_Indexed_Subp), Loc), + Parameter_Associations => + New_List ( + New_Copy_Tree (Type_Low_Bound (Index_Type)), + Index))); + end; + + -- Otherwise we generate a call to the Empty operation, passing + -- the determined number of elements as saved in Siz_Decl. + + else Init_Stat := Make_Object_Declaration (Loc, Defining_Identifier => Temp, @@ -6974,32 +7097,13 @@ package body Exp_Aggr is New_List (New_Occurrence_Of (Defining_Identifier (Siz_Decl), Loc)))); - - else - Init_Stat := - Make_Object_Declaration (Loc, - Defining_Identifier => Temp, - Object_Definition => New_Occurrence_Of (Typ, Loc), - Expression => Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Entity (New_Indexed_Subp), Loc), - Parameter_Associations => - New_List ( - Make_Integer_Literal (Loc, 1), - Make_Type_Conversion (Loc, - Subtype_Mark => - New_Occurrence_Of - (Etype (First_Formal (Entity (New_Indexed_Subp))), - Loc), - Expression => New_Occurrence_Of - (Defining_Identifier (Siz_Decl), - Loc))))); end if; Append (Init_Stat, Aggr_Code); - -- Size is dynamic: Create declaration for object, and initialize - -- with a call to the null container, or an assignment to it. + -- The container will grow dynamically. Create a declaration for + -- the object, and initialize it either from a call to the Empty + -- function, or from the Empty constant. else Decl := @@ -7044,35 +7148,6 @@ package body Exp_Aggr is ("\this will result in infinite recursion??", Parent (N)); end if; - -- Determine whether this is an indexed aggregate (see RM 4.3.5(25/5)). - - if Present (New_Indexed_Subp) then - if No (Add_Unnamed_Subp) then - Is_Indexed_Aggregate := True; - - else - declare - Comp_Assns : constant List_Id := Component_Associations (N); - Comp_Assn : Node_Id; - - begin - if Present (Comp_Assns) - and then not Is_Empty_List (Comp_Assns) - then - Comp_Assn := First (Comp_Assns); - - if Nkind (Comp_Assn) = N_Component_Association - or else - (Nkind (Comp_Assn) = N_Iterated_Component_Association - and then Present (Defining_Identifier (Comp_Assn))) - then - Is_Indexed_Aggregate := True; - end if; - end if; - end; - end if; - end if; - --------------------------- -- Positional aggregate -- --------------------------- @@ -7170,26 +7245,22 @@ package body Exp_Aggr is and then not Is_Empty_List (Component_Associations (N)) then declare - Insert : constant Entity_Id := Entity (Assign_Indexed_Subp); - Index_Type : constant Entity_Id := - Etype (Next_Formal (First_Formal (Insert))); function Expand_Range_Component (Rng : Node_Id; Expr : Node_Id) return Node_Id; - -- Transform a component assoication with a range into an + -- Transform a component association with a range into an -- explicit loop. If the choice is a subtype name, it is -- rewritten as a range with the corresponding bounds, which -- are known to be static. Comp : Node_Id; - Index : Node_Id; Stat : Node_Id; Key : Node_Id; - ----------------------------- - -- Expand_Raange_Component -- - ----------------------------- + ---------------------------- + -- Expand_Range_Component -- + ---------------------------- function Expand_Range_Component (Rng : Node_Id; @@ -7228,26 +7299,6 @@ package body Exp_Aggr is begin pragma Assert (No (Expressions (N))); - if Siz > 0 then - - -- Modify the call to the constructor to allocate the - -- required size for the aggregwte : call the provided - -- constructor rather than the Empty aggregate. - - Index := Make_Op_Add (Loc, - Left_Opnd => New_Copy_Tree (Type_Low_Bound (Index_Type)), - Right_Opnd => Make_Integer_Literal (Loc, Siz - 1)); - - Set_Expression (Init_Stat, - Make_Function_Call (Loc, - Name => - New_Occurrence_Of (Entity (New_Indexed_Subp), Loc), - Parameter_Associations => - New_List ( - New_Copy_Tree (Type_Low_Bound (Index_Type)), - Index))); - end if; - Comp := First (Component_Associations (N)); -- The choice may be a static value, or a range with |