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 <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.
From-SVN: r256485
+2018-01-11 Ed Schonberg <schonberg@adacore.com>
+
+ * 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 <squirek@adacore.com>
* sem_prag.adb (Analyze_Pragma:Pragma_Loop_Variant): Modify error
-- 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;
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
-- 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));
-- 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
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,
-- 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
-- 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;
-- 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.
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.
-----------------------
(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));
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;
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
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
projects / gcc.git / commitdiff