[Ada] Ada_2020: Implement Key_Expression for named container aggregates

gcc/ada/

	* par-ch4.adb: (P_Aggregate_Or_Paren_Expr): Recognize
	Iterated_Element_Component.
	(P_Iterated_Component_Association): Rebuild node as an Iterated_
	Element_Association when Key_Expression is present, and attach
	either the Loop_Parameter_Specification or the
	Iterator_Specification to the new node.
	* sem_aggr.adb: (Resolve_Container_Aggregate):
	Resolve_Iterated_Association handles bota Iterated_Component_
	and Iterated_Element_Associations, in which case it analyzes and
	resoles the orresponding Key_Expression.
	* exp_aggr.adb (Expand_Iterated_Component): If a Key_Expression
	is present, use it as the required parameter in the call to the
	insertion routine for the destination container aggregate. Call
	this routine for both kinds of Iterated_Associations.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index ea95cb6..01e5c83 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6899,23 +6899,62 @@ package body Exp_Aggr is
 
       procedure Expand_Iterated_Component (Comp : Node_Id) is
          Expr    : constant Node_Id := Expression (Comp);
-         Loop_Id : constant Entity_Id :=
-            Make_Defining_Identifier (Loc,
-              Chars => Chars (Defining_Identifier (Comp)));
 
+         Key_Expr           : Node_Id := Empty;
+         Loop_Id            : Entity_Id;
          L_Range            : Node_Id;
          L_Iteration_Scheme : Node_Id;
          Loop_Stat          : Node_Id;
          Stats              : List_Id;
 
       begin
-         if Present (Iterator_Specification (Comp)) then
+         if Nkind (Comp) = N_Iterated_Element_Association then
+            Key_Expr := Key_Expression (Comp);
+
+            --  We create a new entity as loop identifier in all cases,
+            --  as is done for generated loops elsewhere, as the loop
+            --  structure has been previously analyzed.
+
+            if Present (Iterator_Specification (Comp)) then
+
+               --  Either an Iterator_Specification of a Loop_Parameter_
+               --  Specification is present.
+
+               L_Iteration_Scheme :=
+                 Make_Iteration_Scheme (Loc,
+                   Iterator_Specification => Iterator_Specification (Comp));
+               Loop_Id :=
+                  Make_Defining_Identifier (Loc,
+                    Chars => Chars (Defining_Identifier
+                               (Iterator_Specification (Comp))));
+               Set_Defining_Identifier
+                  (Iterator_Specification (L_Iteration_Scheme), Loop_Id);
+
+            else
+               L_Iteration_Scheme :=
+                 Make_Iteration_Scheme (Loc,
+                   Loop_Parameter_Specification =>
+                     Loop_Parameter_Specification (Comp));
+               Loop_Id :=
+                  Make_Defining_Identifier (Loc,
+                    Chars => Chars (Defining_Identifier
+                               (Loop_Parameter_Specification (Comp))));
+               Set_Defining_Identifier
+                  (Loop_Parameter_Specification
+                     (L_Iteration_Scheme), Loop_Id);
+            end if;
+
+         elsif Present (Iterator_Specification (Comp)) then
             L_Iteration_Scheme :=
               Make_Iteration_Scheme (Loc,
                 Iterator_Specification => Iterator_Specification (Comp));
 
          else
             L_Range := Relocate_Node (First (Discrete_Choices (Comp)));
+            Loop_Id :=
+              Make_Defining_Identifier (Loc,
+                Chars => Chars (Defining_Identifier (Comp)));
+
             L_Iteration_Scheme :=
               Make_Iteration_Scheme (Loc,
                 Loop_Parameter_Specification =>
@@ -6928,6 +6967,9 @@ package body Exp_Aggr is
          --  expression is needed. For a named aggregate, the loop variable,
          --  whose type is that of the key, is an additional parameter for
          --  the insertion operation.
+         --  If a Key_Expression is present, it serves as the additional
+         --  parameter. Otherwise the key is given by the loop parameter
+         --  itself.
 
          if Present (Add_Unnamed_Subp) then
             Stats := New_List
@@ -6937,13 +6979,27 @@ package body Exp_Aggr is
                    New_List (New_Occurrence_Of (Temp, Loc),
                      New_Copy_Tree (Expr))));
          else
-            Stats := New_List
-              (Make_Procedure_Call_Statement (Loc,
-                 Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
-                 Parameter_Associations =>
-                   New_List (New_Occurrence_Of (Temp, Loc),
-                     New_Occurrence_Of (Loop_Id, Loc),
-                     New_Copy_Tree (Expr))));
+            --  Named or indexed aggregate, for which a key is present,
+            --  possibly with a specified key_expression.
+
+            if Present (Key_Expr) then
+               Stats := New_List
+                 (Make_Procedure_Call_Statement (Loc,
+                    Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
+                    Parameter_Associations =>
+                      New_List (New_Occurrence_Of (Temp, Loc),
+                        New_Copy_Tree (Key_Expr),
+                        New_Copy_Tree (Expr))));
+
+            else
+               Stats := New_List
+                 (Make_Procedure_Call_Statement (Loc,
+                    Name => New_Occurrence_Of (Entity (Add_Named_Subp), Loc),
+                    Parameter_Associations =>
+                      New_List (New_Occurrence_Of (Temp, Loc),
+                        New_Occurrence_Of (Loop_Id, Loc),
+                        New_Copy_Tree (Expr))));
+            end if;
          end if;
 
          Loop_Stat :=  Make_Implicit_Loop_Statement
@@ -7029,7 +7085,9 @@ package body Exp_Aggr is
             --  generate an insertion statement for each.
 
             while Present (Comp) loop
-               if Nkind (Comp) = N_Iterated_Component_Association then
+               if Nkind (Comp) in N_Iterated_Component_Association
+                                | N_Iterated_Element_Association
+               then
                   Expand_Iterated_Component (Comp);
                else
                   Key := First (Choices (Comp));

diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 649c88e..501429d 100644 (file)
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -1607,8 +1607,11 @@ package body Ch4 is
          --  identifier or OTHERS follows (the latter cases are missing
          --  comma cases). Also assume positional if a semicolon follows,
          --  which can happen if there are missing parens.
+         --  In Ada_2012 and Ada_2020 an iterated association can appear.
 
-         elsif Nkind (Expr_Node) = N_Iterated_Component_Association then
+         elsif Nkind (Expr_Node) in
+           N_Iterated_Component_Association | N_Iterated_Element_Association
+         then
             if No (Assoc_List) then
                Assoc_List := New_List (Expr_Node);
             else
@@ -3417,6 +3420,7 @@ package body Ch4 is
 
    function P_Iterated_Component_Association return Node_Id is
       Assoc_Node : Node_Id;
+      Choice     : Node_Id;
       Id         : Node_Id;
       Iter_Spec  : Node_Id;
       Loop_Spec  : Node_Id;
@@ -3451,15 +3455,25 @@ package body Ch4 is
 
          if Token = Tok_Use then
 
-            --  Key-expression is present, rewrite node as an
+            --  Ada_2020 Key-expression is present, rewrite node as an
             --  iterated_Element_Awwoiation.
 
             Scan;  --  past USE
             Loop_Spec :=
               New_Node (N_Loop_Parameter_Specification, Prev_Token_Ptr);
             Set_Defining_Identifier (Loop_Spec, Id);
-            Set_Discrete_Subtype_Definition (Loop_Spec,
-               First (Discrete_Choices (Assoc_Node)));
+
+            Choice :=  First (Discrete_Choices (Assoc_Node));
+
+            if Present (Next (Choice)) then
+               Error_Msg_N ("expect loop parameter specification", Choice);
+            end if;
+
+            Remove (Choice);
+            Set_Discrete_Subtype_Definition (Loop_Spec, Choice);
+
+            Assoc_Node :=
+              New_Node (N_Iterated_Element_Association, Prev_Token_Ptr);
             Set_Loop_Parameter_Specification (Assoc_Node, Loop_Spec);
             Set_Key_Expression (Assoc_Node, P_Expression);
          end if;

diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index 1ada4f6..eb69561 100644 (file)
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -48,6 +48,7 @@ with Sem;      use Sem;
 with Sem_Aux;  use Sem_Aux;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch3;  use Sem_Ch3;
+with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch13; use Sem_Ch13;
 with Sem_Dim;  use Sem_Dim;
@@ -2646,11 +2647,12 @@ package body Sem_Aggr is
    ---------------------------------
 
    procedure Resolve_Container_Aggregate (N : Node_Id; Typ : Entity_Id) is
-      procedure Resolve_Iterated_Component_Association
+      procedure Resolve_Iterated_Association
        (Comp      : Node_Id;
         Key_Type  : Entity_Id;
         Elmt_Type : Entity_Id);
-      --  Resolve choices and expression in an iterated component association.
+      --  Resolve choices and expression in an iterated component association
+      --  or an iterated element association, which has a key_expression.
       --  This is similar but not identical to the handling of this construct
       --  in an array aggregate.
       --  For a named container, the type of each choice must be compatible
@@ -2666,25 +2668,54 @@ package body Sem_Aggr is
       New_Indexed_Subp    : Node_Id := Empty;
       Assign_Indexed_Subp : Node_Id := Empty;
 
-      --------------------------------------------
-      -- Resolve_Iterated_Component_Association --
-      --------------------------------------------
+      ----------------------------------
+      -- Resolve_Iterated_Association --
+      ----------------------------------
 
-      procedure Resolve_Iterated_Component_Association
+      procedure Resolve_Iterated_Association
        (Comp      : Node_Id;
         Key_Type  : Entity_Id;
         Elmt_Type : Entity_Id)
       is
-         Choice : Node_Id;
-         Ent    : Entity_Id;
-         Expr   : Node_Id;
-         Id     : Entity_Id;
-         Iter   : Node_Id;
-         Typ    : Entity_Id := Empty;
+         Choice   : Node_Id;
+         Ent      : Entity_Id;
+         Expr     : Node_Id;
+         Key_Expr : Node_Id;
+         Id       : Entity_Id;
+         Id_Name  : Name_Id;
+         Iter     : Node_Id;
+         Typ      : Entity_Id := Empty;
 
       begin
-         if Present (Iterator_Specification (Comp)) then
-            Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+         --  If this is an Iterated_Element_Association then either a
+         --  an Iterator_Specification or a Loop_Parameter specification
+         --  is present. In both cases a Key_Expression is present.
+
+         if Nkind (Comp) = N_Iterated_Element_Association then
+            if Present (Loop_Parameter_Specification (Comp)) then
+               Analyze_Loop_Parameter_Specification
+                  (Loop_Parameter_Specification (Comp));
+               Id_Name := Chars (Defining_Identifier
+                            (Loop_Parameter_Specification (Comp)));
+            else
+               Iter := Copy_Separate_Tree (Iterator_Specification (Comp));
+               Analyze (Iter);
+               Typ := Etype (Defining_Identifier (Iter));
+               Id_Name := Chars (Defining_Identifier
+                            (Iterator_Specification (Comp)));
+            end if;
+
+            --  Key expression must have the type of the key. We analyze
+            --  a copy of the original expression, because it will be
+            --  reanalyzed and copied as needed during expansion of the
+            --  corresponding loop.
+
+            Key_Expr := Key_Expression (Comp);
+            Analyze_And_Resolve (New_Copy_Tree (Key_Expr), Key_Type);
+
+         elsif Present (Iterator_Specification (Comp)) then
+            Iter    := Copy_Separate_Tree (Iterator_Specification (Comp));
+            Id_Name := Chars (Defining_Identifier (Comp));
             Analyze (Iter);
             Typ := Etype (Defining_Identifier (Iter));
 
@@ -2711,19 +2742,19 @@ package body Sem_Aggr is
 
                Next (Choice);
             end loop;
+
+            Id_Name := Chars (Defining_Identifier (Comp));
          end if;
 
          --  Create a scope in which to introduce an index, which is usually
          --  visible in the expression for the component, and needed for its
          --  analysis.
 
+         Id := Make_Defining_Identifier (Sloc (Comp), Id_Name);
          Ent := New_Internal_Entity (E_Loop, Current_Scope, Sloc (Comp), 'L');
          Set_Etype  (Ent, Standard_Void_Type);
          Set_Parent (Ent, Parent (Comp));
          Push_Scope (Ent);
-         Id :=
-           Make_Defining_Identifier (Sloc (Comp),
-             Chars => Chars (Defining_Identifier (Comp)));
 
          --  Insert and decorate the loop variable in the current scope.
          --  The expression has to be analyzed once the loop variable is
@@ -2752,7 +2783,8 @@ package body Sem_Aggr is
          Expr := New_Copy_Tree (Expression (Comp));
          Preanalyze_And_Resolve (Expr, Elmt_Type);
          End_Scope;
-      end Resolve_Iterated_Component_Association;
+
+      end Resolve_Iterated_Association;
 
    begin
       pragma Assert (Nkind (Asp) = N_Aggregate);
@@ -2797,7 +2829,7 @@ package body Sem_Aggr is
                           & "for unnamed container aggregate", Comp);
                         return;
                      else
-                        Resolve_Iterated_Component_Association
+                        Resolve_Iterated_Association
                           (Comp, Empty, Elmt_Type);
                      end if;
 
@@ -2837,8 +2869,11 @@ package body Sem_Aggr is
 
                   Analyze_And_Resolve (Expression (Comp), Elmt_Type);
 
-               elsif Nkind (Comp) = N_Iterated_Component_Association then
-                  Resolve_Iterated_Component_Association
+               elsif Nkind (Comp) in
+                 N_Iterated_Component_Association |
+                 N_Iterated_Element_Association
+               then
+                  Resolve_Iterated_Association
                     (Comp, Key_Type, Elmt_Type);
                end if;
 
@@ -2883,8 +2918,11 @@ package body Sem_Aggr is
 
                      Analyze_And_Resolve (Expression (Comp), Comp_Type);
 
-                  elsif Nkind (Comp) = N_Iterated_Component_Association then
-                     Resolve_Iterated_Component_Association
+                  elsif Nkind (Comp) in
+                    N_Iterated_Component_Association |
+                    N_Iterated_Element_Association
+                  then
+                     Resolve_Iterated_Association
                        (Comp, Index_Type, Comp_Type);
                   end if;