@@ -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.
-------------------------- 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;
--- 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
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; Tested on x86_64-pc-linux-gnu, committed on trunk 2018-01-11 Ed Schonberg <schonberg@adacore.com> 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.