diff mbox series

[Ada] Fix double identifiers in iterated component association

Message ID 20220905072604.GA1174699@poulhies-Precision-5550
State New
Headers show
Series [Ada] Fix double identifiers in iterated component association | expand

Commit Message

Marc Poulhiès Sept. 5, 2022, 7:26 a.m. UTC
The iterated_component_association grammar construct appears in Ada RM
in two syntactic forms: with iterator_specification and with
defining_identifier. This is now properly reflected in the GNAT AST,
while previously we had two defining_identifiers regardless of the
syntactic form.

Cleanup related to handling of iterated_component_association in SPARK.
Behavior of the compiler itself should not be affected.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* exp_aggr.adb (Two_Pass_Aggregate_Expansion): Expand iterated
	component association with an unanalyzed copy of iterated
	expression. The previous code worked only because the expanded
	loop used both an analyzed copy of the iterator_specification and
	an analyzed copy of the iterated expression. Now the iterated
	expression is reanalyzed in the context of the expanded loop.
	* par-ch4.adb (Build_Iterated_Component_Association): Don't set
	defining identifier when iterator specification is present.
	* sem_aggr.adb (Resolve_Iterated_Association): Pick index name
	from the iterator specification.
	* sem_elab.adb (Traverse_Potential_Scenario): Handle iterated
	element association just like iterated component association. Not
	strictly part of this fix, but still worth for the completeness.
	* sem_res.adb (Resolve): Pick index name from the iterator
	specification, when present.
	* sem_util.adb (Traverse_More): For completeness, just like the
	change in Traverse_Potential_Scenario.
	* sinfo.ads
	(ITERATED_COMPONENT_ASSOCIATION): Fix and complete description.
	(ITERATED_ELEMENT_ASSOCIATION): Likewise.
diff mbox series

Patch

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6536,7 +6536,7 @@  package body Exp_Aggr is
                     Prefix => New_Occurrence_Of (TmpE, Loc),
                     Expressions =>
                       New_List (New_Occurrence_Of (Index_Id, Loc))),
-               Expression => New_Copy_Tree (Expression (Assoc)));
+               Expression => Copy_Separate_Tree (Expression (Assoc)));
 
             --  Advance index position for insertion.
 
@@ -7500,11 +7500,11 @@  package body Exp_Aggr is
 
             --  Iterated_Component_Association.
 
-            Loop_Id :=
-              Make_Defining_Identifier (Loc,
-                Chars => Chars (Defining_Identifier (Comp)));
-
             if Present (Iterator_Specification (Comp)) then
+               Loop_Id :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => Chars (Defining_Identifier
+                              (Iterator_Specification (Comp))));
                L_Iteration_Scheme :=
                  Make_Iteration_Scheme (Loc,
                    Iterator_Specification => Iterator_Specification (Comp));
@@ -7513,6 +7513,9 @@  package body Exp_Aggr is
                --  Loop_Parameter_Specification is parsed with a choice list.
                --  where the range is the first (and only) choice.
 
+               Loop_Id :=
+                 Make_Defining_Identifier (Loc,
+                   Chars => Chars (Defining_Identifier (Comp)));
                L_Range := Relocate_Node (First (Discrete_Choices (Comp)));
 
                L_Iteration_Scheme :=


diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -3554,7 +3554,6 @@  package body Ch4 is
          when Tok_Of =>
             Restore_Scan_State (State);
             Scan;  -- past OF
-            Set_Defining_Identifier (Assoc_Node, Id);
             Iter_Spec := P_Iterator_Specification (Id);
             Set_Iterator_Specification (Assoc_Node, Iter_Spec);
 


diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -3053,7 +3053,8 @@  package body Sem_Aggr is
 
          elsif Present (Iterator_Specification (Comp)) then
             Copy    := Copy_Separate_Tree (Iterator_Specification (Comp));
-            Id_Name := Chars (Defining_Identifier (Comp));
+            Id_Name :=
+              Chars (Defining_Identifier (Iterator_Specification (Comp)));
 
             Analyze (Copy);
             Typ := Etype (Defining_Identifier (Copy));


diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -3339,7 +3339,9 @@  package body Sem_Elab is
                Traverse_List (Else_Actions (Scen));
 
             elsif Nkind (Scen) in
-                    N_Component_Association | N_Iterated_Component_Association
+                    N_Component_Association
+                  | N_Iterated_Component_Association
+                  | N_Iterated_Element_Association
             then
                Traverse_List (Loop_Actions (Scen));
 


diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -3163,9 +3163,21 @@  package body Sem_Res is
                    = N_Iterated_Component_Association
                  and then Is_Boolean_Type (Typ)
                then
-                  Error_Msg_N -- CODEFIX
-                    ("missing ALL or SOME in quantified expression",
-                     Defining_Identifier (First (Component_Associations (N))));
+                  if Present
+                       (Iterator_Specification
+                         (First (Component_Associations (N))))
+                  then
+                     Error_Msg_N -- CODEFIX
+                       ("missing ALL or SOME in quantified expression",
+                        Defining_Identifier
+                          (Iterator_Specification
+                            (First (Component_Associations (N)))));
+                  else
+                     Error_Msg_N -- CODEFIX
+                       ("missing ALL or SOME in quantified expression",
+                        Defining_Identifier
+                          (First (Component_Associations (N))));
+                  end if;
 
                --  For an operator with no interpretation, check whether
                --  one of its operands may be a user-defined literal.


diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -29500,6 +29500,9 @@  package body Sem_Util is
             when N_Iterated_Component_Association =>
                Traverse_More (Loop_Actions (Node),      Result);
 
+            when N_Iterated_Element_Association =>
+               Traverse_More (Loop_Actions (Node),      Result);
+
             when N_Iteration_Scheme =>
                Traverse_More (Condition_Actions (Node), Result);
 


diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -4183,11 +4183,15 @@  package Sinfo is
 
       --  ITERATED_COMPONENT_ASSOCIATION ::=
       --    for DEFINING_IDENTIFIER in DISCRETE_CHOICE_LIST => EXPRESSION
+      --    for ITERATOR_SPECIFICATION => EXPRESSION
+
+      --  At most one of (Defining_Identifier, Iterator_Specification)
+      --  is present at a time, in which case the other one is empty.
 
       --  N_Iterated_Component_Association
       --  Sloc points to FOR
       --  Defining_Identifier
-      --  Iterator_Specification (set to Empty if no Iterator_Spec)
+      --  Iterator_Specification
       --  Expression
       --  Discrete_Choices
       --  Loop_Actions
@@ -4207,9 +4211,13 @@  package Sinfo is
       --  Etype
 
       ---------------------------------
-      --  3.4.5 Comtainer_Aggregates --
+      --  3.4.5 Container_Aggregates --
       ---------------------------------
 
+      --  ITERATED_ELEMENT_ASSOCIATION ::=
+      --    for LOOP_PARAMETER_SPECIFICATION[ use KEY_EXPRESSION] => EXPRESSION
+      --  | for ITERATOR_SPECIFICATION[ use KEY_EXPRESSION] => EXPRESSION
+
       --  N_Iterated_Element_Association
       --  Key_Expression
       --  Iterator_Specification