[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  <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

gcc/ada/ChangeLog

+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

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.
 
          -----------------------

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