From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 21 Sep 2020 13:37:46 +0000 (+0200)
Subject: [Ada] Multidimensional arrays with Iterated_Component_Associations
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=fb00cc7032bf1129373edd2bd99cf02fe03fd1d8;p=gcc.git

[Ada] Multidimensional arrays with Iterated_Component_Associations

gcc/ada/

	* sem_aggr.adb (Resolve_Iterated_Component_Association): new
	internal subprogram Remove_References, to reset semantic
	information on each reference to the index variable of the
	association, so that Collect_Aggregate_Bounds can work properly
	on multidimensional arrays with nested associations, and
	subsequent expansion into loops can verify that dimensions of
	each subaggregate are compatible.
---

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 71b9bccc3c1..90ddee27afd 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -452,7 +452,7 @@ package body Sem_Aggr is
          This_Range : constant Node_Id := Aggregate_Bounds (N);
          --  The aggregate range node of this specific sub-aggregate
 
-         This_Low  : constant Node_Id := Low_Bound (Aggregate_Bounds (N));
+         This_Low  : constant Node_Id := Low_Bound  (Aggregate_Bounds (N));
          This_High : constant Node_Id := High_Bound (Aggregate_Bounds (N));
          --  The aggregate bounds of this specific sub-aggregate
 
@@ -785,7 +785,7 @@ package body Sem_Aggr is
    -----------------------
 
    procedure Resolve_Aggregate (N : Node_Id; Typ : Entity_Id) is
-      Loc   : constant Source_Ptr := Sloc (N);
+      Loc : constant Source_Ptr := Sloc (N);
 
       Aggr_Subtyp : Entity_Id;
       --  The actual aggregate subtype. This is not necessarily the same as Typ
@@ -816,6 +816,8 @@ package body Sem_Aggr is
          return False;
       end Within_Aggregate;
 
+   --  Start of processing for Resolve_Aggregate
+
    begin
       --  Ignore junk empty aggregate resulting from parser error
 
@@ -1588,12 +1590,39 @@ package body Sem_Aggr is
          Index_Typ : Entity_Id)
       is
          Loc : constant Source_Ptr := Sloc (N);
+         Id  : constant Entity_Id  := Defining_Identifier (N);
+
+         -----------------------
+         -- Remove_References --
+         -----------------------
+
+         function Remove_Ref (N : Node_Id) return Traverse_Result;
+         --  Remove references to the entity Id after analysis, so it can be
+         --  properly reanalyzed after construct is expanded into a loop.
+
+         function Remove_Ref (N : Node_Id) return Traverse_Result is
+         begin
+            if Nkind (N) = N_Identifier
+               and then Present (Entity (N))
+               and then Entity (N) = Id
+            then
+               Set_Entity (N, Empty);
+               Set_Etype (N, Empty);
+            end if;
+            Set_Analyzed (N, False);
+            return OK;
+         end Remove_Ref;
+
+         procedure Remove_References is new Traverse_Proc (Remove_Ref);
+
+         --  Local variables
 
          Choice : Node_Id;
          Dummy  : Boolean;
          Ent    : Entity_Id;
          Expr   : Node_Id;
-         Id     : Entity_Id;
+
+      --  Start of processing for Resolve_Iterated_Component_Association
 
       begin
          --  An element iterator specification cannot appear in
@@ -1646,26 +1675,28 @@ package body Sem_Aggr is
          --  The expression has to be analyzed once the index variable is
          --  directly visible.
 
-         Id := Defining_Identifier (N);
          Enter_Name (Id);
          Set_Etype (Id, Index_Typ);
          Set_Ekind (Id, E_Variable);
          Set_Scope (Id, Ent);
 
-         --  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.
+         --  Analyze the expression without expansion, to verify legality.
+         --  After analysis we remove references to the index variable 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));
-         Set_Parent (Expr, N);
-         Dummy := Resolve_Aggr_Expr (Expr, False);
+         Expr := Expression (N);
+
+         Expander_Mode_Save_And_Set (False);
+         Dummy := Resolve_Aggr_Expr (Expr, Single_Elmt => False);
+         Expander_Mode_Restore;
+         Remove_References (Expr);
 
          --  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));
@@ -2572,7 +2603,7 @@ package body Sem_Aggr is
             --  In order to diagnose the semantic error we create a duplicate
             --  tree to analyze it and perform the check.
 
-            else
+            elsif Nkind (Assoc) /= N_Iterated_Component_Association then
                declare
                   Save_Analysis : constant Boolean := Full_Analysis;
                   Expr          : constant Node_Id :=