[Ada] Fix resolution of iterated component association

Message ID 20220905072600.GA1174639@poulhies-Precision-5550
State New, archived
Headers
Series [Ada] Fix resolution of iterated component association |

Commit Message

Marc Poulhiès Sept. 5, 2022, 7:26 a.m. UTC
  For iterator specification appearing inside an iterated component
association, we just did ad-hoc, incomplete checks and delayed a proper
analysis until the iterated component association is expanded into loop (and
then reanalyzed).

However, when the iterated component association is not expanded, e.g.
because we are in semantic checking mode, GNATprove mode or inside a
generic, then the AST lacked any processing or error reporting.

This is fixed by reusing the existing analysis of iterator specifications,
as they also appear in other constructs, e.g. in quantified expressions.

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

gcc/ada/

	* sem_aggr.adb (Resolve_Iterated_Component_Association): Split
	processing of cases with and without iterator specification; reuse
	analysis of iterator specification; improve diagnostics for
	premature usage of iterator index in discrete choices.
  

Patch

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
@@ -1742,8 +1742,6 @@  package body Sem_Aggr is
          Loc : constant Source_Ptr := Sloc (N);
          Id  : constant Entity_Id  := Defining_Identifier (N);
 
-         Id_Typ : Entity_Id := Any_Type;
-
          -----------------------
          -- Remove_References --
          -----------------------
@@ -1779,37 +1777,29 @@  package body Sem_Aggr is
       begin
          Error_Msg_Ada_2022_Feature ("iterated component", Loc);
 
-         if Present (Iterator_Specification (N)) then
-            Analyze (Name (Iterator_Specification (N)));
+         --  Create a scope in which to introduce an index, to make it visible
+         --  for the analysis of component expression.
 
-            --  We assume that the domain of iteration cannot be overloaded.
+         Scop := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L');
+         Set_Etype  (Scop, Standard_Void_Type);
+         Set_Parent (Scop, Parent (N));
+         Push_Scope (Scop);
 
-            declare
-               Domain : constant Node_Id := Name (Iterator_Specification (N));
-               D_Type : constant Entity_Id := Etype (Domain);
-               Elt    : Entity_Id;
-            begin
-               if Is_Array_Type (D_Type) then
-                  Id_Typ := Component_Type (D_Type);
+         --  If there is iterator specification, then its preanalysis will make
+         --  the index visible.
 
-               else
-                  if Has_Aspect (D_Type, Aspect_Iterable) then
-                     Elt :=
-                       Get_Iterable_Type_Primitive (D_Type, Name_Element);
-                     if No (Elt) then
-                        Error_Msg_N
-                          ("missing Element primitive for iteration", Domain);
-                     else
-                        Id_Typ := Etype (Elt);
-                     end if;
-                  else
-                     Error_Msg_N ("cannot iterate over", Domain);
-                  end if;
-               end if;
-            end;
+         if Present (Iterator_Specification (N)) then
+            Preanalyze (Iterator_Specification (N));
+
+         --  Otherwise, analyze discrete choices and make the index visible
 
          else
-            Id_Typ := Index_Typ;
+            --  Insert index name into current scope but don't decorate it yet,
+            --  so that a premature usage of this name in discrete choices will
+            --  be nicely diagnosed.
+
+            Enter_Name (Id);
+
             Choice := First (Discrete_Choices (N));
 
             while Present (Choice) loop
@@ -1835,25 +1825,13 @@  package body Sem_Aggr is
 
                Next (Choice);
             end loop;
-         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.
 
-         Scop := New_Internal_Entity (E_Loop, Current_Scope, Loc, 'L');
-         Set_Etype  (Scop, Standard_Void_Type);
-         Set_Parent (Scop, Parent (N));
-         Push_Scope (Scop);
+            --  Decorate the index variable
 
-         --  Insert and decorate the index variable in the current scope.
-         --  The expression has to be analyzed once the index variable is
-         --  directly visible.
-
-         Enter_Name (Id);
-         Set_Etype (Id, Id_Typ);
-         Mutate_Ekind (Id, E_Variable);
-         Set_Scope (Id, Scop);
+            Set_Etype (Id, Index_Typ);
+            Mutate_Ekind (Id, E_Variable);
+            Set_Scope (Id, Scop);
+         end if;
 
          --  Analyze  expression without expansion, to verify legality.
          --  When generating code, we then remove references to the index