[Ada] Fix resolution of subtype_indication in delta aggregates

[Ada] Fix resolution of subtype_indication in delta aggregates

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 841 bytes --]

For a Subtype_Indication in ordinary array aggregates we explicitly call
Resolve_Discrete_Subtype_Indication; for a Subtype_Indication in delta
array aggregates we implicitly call Sem_Ch3.Analyze_Subtype_Indication,
which is only meant to be used in declarations, not in expressions.

This subtle difference causes a crash in GNATprove mode when delta
aggregate appears inside a body that is inlined-for-proof (which
involves an unusual combination of flags Expander_Active, Full_Analysis
and GNATprove_Mode).

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

gcc/ada/

	* sem_aggr.adb (Resolve_Delta_Array_Aggregate): If the choice is
	a subtype_indication then call
	Resolve_Discrete_Subtype_Indication; both for choices
	immediately inside array delta aggregates and inside
	iterated_component_association within array delta aggregates.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 2282 bytes --]

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
@@ -3072,6 +3072,10 @@ package body Sem_Aggr is
                   Error_Msg_N
                     ("others not allowed in delta aggregate", Choice);
 
+               elsif Nkind (Choice) = N_Subtype_Indication then
+                  Resolve_Discrete_Subtype_Indication
+                    (Choice, Base_Type (Index_Type));
+
                else
                   Analyze_And_Resolve (Choice, Index_Type);
                end if;
@@ -3109,28 +3113,31 @@ package body Sem_Aggr is
          else
             Choice := First (Choice_List (Assoc));
             while Present (Choice) loop
+               Analyze (Choice);
+
                if Nkind (Choice) = N_Others_Choice then
                   Error_Msg_N
                     ("others not allowed in delta aggregate", Choice);
 
-               else
-                  Analyze (Choice);
+               elsif Is_Entity_Name (Choice)
+                 and then Is_Type (Entity (Choice))
+               then
+                  --  Choice covers a range of values
 
-                  if Is_Entity_Name (Choice)
-                    and then Is_Type (Entity (Choice))
+                  if Base_Type (Entity (Choice)) /=
+                     Base_Type (Index_Type)
                   then
-                     --  Choice covers a range of values
-
-                     if Base_Type (Entity (Choice)) /=
-                        Base_Type (Index_Type)
-                     then
-                        Error_Msg_NE
-                          ("choice does not match index type of &",
-                           Choice, Typ);
-                     end if;
-                  else
-                     Resolve (Choice, Index_Type);
+                     Error_Msg_NE
+                       ("choice does not match index type of &",
+                        Choice, Typ);
                   end if;
+
+               elsif Nkind (Choice) = N_Subtype_Indication then
+                  Resolve_Discrete_Subtype_Indication
+                    (Choice, Base_Type (Index_Type));
+
+               else
+                  Resolve (Choice, Index_Type);
                end if;
 
                Next (Choice);