[Ada] Crash on declaration with aggregate for unchecked union
authorEd Schonberg <schonberg@adacore.com>
Tue, 5 May 2020 00:05:03 +0000 (20:05 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Mon, 6 Jul 2020 11:34:56 +0000 (07:34 -0400)
gcc/ada/

* sem_ch3.adb (Analyze_Object_Declaration): If the type is an
Unchecked_Union, and the expression is an aggregate. complete
the analysis and resolution of the aggregate, and treat like a
regular object declaration, instead of as a renaming
declarattion.

gcc/ada/sem_ch3.adb

index 9e60d75152d24c7e4bad1efe35cdf25da05507c8..c105f3c83e8688facc8fda99c6b901f0b9f14b08 100644 (file)
@@ -4564,16 +4564,26 @@ package body Sem_Ch3 is
                   Set_Ekind (Id, E_Variable);
                end if;
 
-               Rewrite (N,
-                 Make_Object_Renaming_Declaration (Loc,
-                   Defining_Identifier => Id,
-                   Subtype_Mark        => New_Occurrence_Of (T, Loc),
-                   Name                => E));
-
-               Set_Renamed_Object (Id, E);
-               Freeze_Before (N, T);
-               Set_Is_Frozen (Id);
-               goto Leave;
+               --  If the expression is an aggregate it contains the required
+               --  discriminant values but it has not been resolved yet, so do
+               --  it now, and treat it as the initial expression of an object
+               --  declaration, rather than a renaming.
+
+               if Nkind (E) = N_Aggregate then
+                  Analyze_And_Resolve (E, T);
+
+               else
+                  Rewrite (N,
+                    Make_Object_Renaming_Declaration (Loc,
+                      Defining_Identifier => Id,
+                      Subtype_Mark        => New_Occurrence_Of (T, Loc),
+                      Name                => E));
+
+                  Set_Renamed_Object (Id, E);
+                  Freeze_Before (N, T);
+                  Set_Is_Frozen (Id);
+                  goto Leave;
+               end if;
 
             else
                --  Ensure that the generated subtype has a unique external name