From d940c627e077379a534d69025f6a962f8caf4b39 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 11 Jan 2018 08:50:29 +0000 Subject: [Ada] Crash on iterated_component_association in expression function This patch improves on the handling of the Ada2020 construct Iterated_ Component_Association in various contexts, when the expression involved is a record or array aggregate. Executing: gnatmake -gnatX -q main ./main must yield: 123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ ---- with Text_IO; use Text_IO; with Exfor; use Exfor; procedure Main is Map : String := Table_ASCII; begin Put_Line (Map (50..91)); end; ---- package Exfor is function Table_ASCII return String is (for I in 1 .. Character'Pos (Character'Last) + 1 => Character'Val(I-1)); end Exfor; 2018-01-11 Ed Schonberg gcc/ada/ * sem_aggr.adb (Resolve_Iterated_Component_Association): Perform analysis on a copy of the expression with a copy of the index variable, because full expansion will rewrite construct into a loop with the original loop variable. * exp_aggr.adb (Gen_Assign): Defer analysis and resolution if the expression is an iterated component association. Full analysis takes place when construct is rewritten as a loop. (In_Place_Assign_OK, Safe_Component): An iterated_component_association is not safe for in-place assignment. * sem_util.adb (Remove_Entity): Handle properly the case of an isolated entity with no homonym and no other entity in the scope. From-SVN: r256485 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/exp_aggr.adb | 40 ++++++++++++++++++++++++++++------------ gcc/ada/sem_aggr.adb | 41 +++++++++++++++++++++++++++++------------ gcc/ada/sem_util.adb | 14 +++++++++----- 4 files changed, 80 insertions(+), 29 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aff841e..105bb2f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2018-01-11 Ed Schonberg + + * sem_aggr.adb (Resolve_Iterated_Component_Association): Perform + analysis on a copy of the expression with a copy of the index variable, + because full expansion will rewrite construct into a loop with the + original loop variable. + * exp_aggr.adb (Gen_Assign): Defer analysis and resolution if the + expression is an iterated component association. Full analysis takes + place when construct is rewritten as a loop. + (In_Place_Assign_OK, Safe_Component): An iterated_component_association + is not safe for in-place assignment. + * sem_util.adb (Remove_Entity): Handle properly the case of an isolated + entity with no homonym and no other entity in the scope. + 2018-01-11 Justin Squirek * sem_prag.adb (Analyze_Pragma:Pragma_Loop_Variant): Modify error diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 92c040e..6aff4dd 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -240,7 +240,7 @@ package body Exp_Aggr is -- calling Flatten. -- -- This function also detects and warns about one-component aggregates that - -- appear in a non-static context. Even if the component value is static, + -- appear in a nonstatic context. Even if the component value is static, -- such an aggregate must be expanded into an assignment. function Backend_Processing_Possible (N : Node_Id) return Boolean; @@ -492,7 +492,7 @@ package body Exp_Aggr is end if; -- One-component aggregates are suspicious, and if the context type - -- is an object declaration with non-static bounds it will trip gcc; + -- is an object declaration with nonstatic bounds it will trip gcc; -- such an aggregate must be expanded into a single assignment. if Hiv = Lov and then Nkind (Parent (N)) = N_Object_Declaration then @@ -674,7 +674,7 @@ package body Exp_Aggr is -- Recurse to check subaggregates, which may appear in qualified -- expressions. If delayed, the front-end will have to expand. - -- If the component is a discriminated record, treat as non-static, + -- If the component is a discriminated record, treat as nonstatic, -- as the back-end cannot handle this properly. Expr := First (Expressions (N)); @@ -1537,11 +1537,17 @@ package body Exp_Aggr is -- of the generated loop will analyze the expression in the -- proper context, in which the loop parameter is visible. - if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) - and then - Nkind (Parent (Expr_Q)) /= N_Iterated_Component_Association - then - Analyze_And_Resolve (Expr_Q, Comp_Typ); + if Present (Comp_Typ) and then not Is_Array_Type (Comp_Typ) then + if + Nkind (Parent (Expr_Q)) = N_Iterated_Component_Association + or else + Nkind (Parent (Parent ((Expr_Q)))) + = N_Iterated_Component_Association + then + null; + else + Analyze_And_Resolve (Expr_Q, Comp_Typ); + end if; end if; if Is_Delayed_Aggregate (Expr_Q) then @@ -4045,7 +4051,7 @@ package body Exp_Aggr is Next_Elmt (Disc2); end loop; - -- If any discriminant constraint is non-static, emit a check + -- If any discriminant constraint is nonstatic, emit a check if Present (Cond) then Insert_Action (N, @@ -4298,7 +4304,7 @@ package body Exp_Aggr is -- Check whether all components of the aggregate are compile-time known -- values, and can be passed as is to the back-end without further -- expansion. - -- An Iterated_Component_Association is treated as non-static, but there + -- An Iterated_Component_Association is treated as nonstatic, but there -- are possibilities for optimization here. function Flatten @@ -5493,6 +5499,16 @@ package body Exp_Aggr is -- For now, too complex to analyze return False; + + elsif + Nkind (Parent (Expr)) = N_Iterated_Component_Association + then + + -- Ditto for iterated component associations, which in + -- general require an enclosing loop and involve nonstatic + -- expressions. + + return False; end if; Comp := New_Copy_Tree (Expr); @@ -5555,7 +5571,7 @@ package body Exp_Aggr is -- bounds. Ditto for an allocator whose qualified expression -- is a constrained type. If the expression in the allocator -- is an unconstrained array, we accept an upper bound that - -- is not static, to allow for non-static expressions of the + -- is not static, to allow for nonstatic expressions of the -- base type. Clearly there are further possibilities (with -- diminishing returns) for safely building arrays in place -- here. @@ -7759,7 +7775,7 @@ package body Exp_Aggr is function Get_Component_Val (N : Node_Id) return Uint; -- Given a expression value N of the component type Ctyp, returns a -- value of Csiz (component size) bits representing this value. If - -- the value is non-static or any other reason exists why the value + -- the value is nonstatic or any other reason exists why the value -- cannot be returned, then Not_Handled is raised. ----------------------- diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 7d6ae41..2a4ab36 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1657,12 +1657,13 @@ package body Sem_Aggr is (N : Node_Id; Index_Typ : Entity_Id) is - Id : constant Entity_Id := Defining_Identifier (N); Loc : constant Source_Ptr := Sloc (N); Choice : Node_Id; Dummy : Boolean; Ent : Entity_Id; + Expr : Node_Id; + Id : Entity_Id; begin Choice := First (Discrete_Choices (N)); @@ -1697,25 +1698,41 @@ package body Sem_Aggr is Ent := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L'); Set_Etype (Ent, Standard_Void_Type); Set_Parent (Ent, Parent (N)); + Push_Scope (Ent); + Id := Make_Defining_Identifier (Loc, + Chars => Chars (Defining_Identifier (N))); - -- Decorate the index variable in the current scope. The association - -- may have several choices, each one leading to a loop, so we create - -- this variable only once to prevent homonyms in this scope. + -- Insert and decorate the index variable in the current scope. -- The expression has to be analyzed once the index variable is -- directly visible. Mark the variable as referenced to prevent -- spurious warnings, given that subsequent uses of its name in the -- expression will reference the internal (synonym) loop variable. - if No (Scope (Id)) then - Enter_Name (Id); - Set_Etype (Id, Index_Typ); - Set_Ekind (Id, E_Variable); - Set_Scope (Id, Ent); - Set_Referenced (Id); + Enter_Name (Id); + Set_Etype (Id, Index_Typ); + Set_Ekind (Id, E_Variable); + Set_Scope (Id, Ent); + Set_Referenced (Id); + + -- Analyze a copy of the expression, to verify legality. We use + -- a copy because the expression will be analyzed anew when the + -- enclosing aggregate is expanded, and the construct is rewritten + -- as a loop with a new index variable. + + Expr := New_Copy_Tree (Expression (N)); + Dummy := Resolve_Aggr_Expr (Expr, False); + + -- An iterated_component_association may appear in a nested + -- aggregate for a multidimensional structure: preserve the bounds + -- computed for the expression, as well as the anonymous array + -- type generated for it; both are needed during array expansion. + -- This does not work for more than two levels of nesting. ??? + + if Nkind (Expr) = N_Aggregate then + Set_Aggregate_Bounds (Expression (N), Aggregate_Bounds (Expr)); + Set_Etype (Expression (N), Etype (Expr)); end if; - Push_Scope (Ent); - Dummy := Resolve_Aggr_Expr (Expression (N), False); End_Scope; end Resolve_Iterated_Component_Association; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 972bda5..932454c 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -22373,11 +22373,13 @@ package body Sem_Util is else Prev_Id := Current_Entity (Id); - while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop - Prev_Id := Homonym (Prev_Id); - end loop; + if Present (Prev_Id) then + while Present (Prev_Id) and then Homonym (Prev_Id) /= Id loop + Prev_Id := Homonym (Prev_Id); + end loop; - Set_Homonym (Prev_Id, Homonym (Id)); + Set_Homonym (Prev_Id, Homonym (Id)); + end if; end if; -- Remove the entity from the scope entity chain. When the entity is @@ -22397,7 +22399,9 @@ package body Sem_Util is Next_Entity (Prev_Id); end loop; - Set_Next_Entity (Prev_Id, Next_Entity (Id)); + if Present (Prev_Id) then + Set_Next_Entity (Prev_Id, Next_Entity (Id)); + end if; end if; -- Handle the case where the entity acts as the tail of the scope entity -- cgit v1.1