===================================================================
@@ -1823,6 +1823,9 @@
-- Used to keep track of the number of discrete choices in the
-- current association.
+ Errors_Posted_On_Choices : Boolean := False;
+ -- Keeps track of whether any choices have semantic errors
+
begin
-- STEP 2 (A): Check discrete choices validity
@@ -1867,6 +1870,14 @@
Check_Unset_Reference (Choice);
Check_Non_Static_Context (Choice);
+ -- If semantic errors were posted on the choice, then
+ -- record that for possible early return from later
+ -- processing (see handling of enumeration choices).
+
+ if Error_Posted (Choice) then
+ Errors_Posted_On_Choices := True;
+ end if;
+
-- Do not range check a choice. This check is redundant
-- since this test is already done when we check that the
-- bounds of the array aggregate are within range.
@@ -2144,13 +2155,12 @@
and then Compile_Time_Known_Value (Choices_Low)
and then Compile_Time_Known_Value (Choices_High)
then
- -- If the bounds have semantic errors, do not attempt
- -- further resolution to prevent cascaded errors.
+ -- If any of the expressions or range bounds in choices
+ -- have semantic errors, then do not attempt further
+ -- resolution, to prevent cascaded errors.
- if Error_Posted (Choices_Low)
- or else Error_Posted (Choices_High)
- then
- return False;
+ if Errors_Posted_On_Choices then
+ return Failure;
end if;
declare
A type mismatch between the bounds of an array aggregate's range choice and the expected index type causes the compiler to crash or go into an infinite loop. Although the compiler catches the type resolution error, and the range is marked as having an error posted, the bounds are not marked, preventing the compiler from aborting its analysis of the aggregate. The fix is to record whether errors are posted on any expression or range choices after their resolution, as a condition for aborting further processing of the aggregate. The test below must issue only the following errors when compiled and not crash or hang the compiler: 1. package Bad_Aggr_Choice_Crash is 2. 3. type Enum is (A, B, C, D, E); 4. 5. A1 : array (Enum) of Boolean := (1 .. 3 => False); -- ERROR | >>> expected type "Enum" defined at line 3 >>> found type universal integer 6. 7. A2 : array (Enum) of Boolean := (A => True, 1 .. 4 => False); -- ERROR 1 2 >>> incompatible types in range >>> expected type "Enum" defined at line 3 >>> found type universal integer 8. 9. end Bad_Aggr_Choice_Crash; package Bad_Aggr_Choice_Crash is type Enum is (A, B, C, D, E); A1 : array (Enum) of Boolean := (1 .. 3 => False); -- ERROR A2 : array (Enum) of Boolean := (A => True, 1 .. 4 => False); -- ERROR end Bad_Aggr_Choice_Crash; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-03 Gary Dismukes <dismukes@adacore.com> * sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete choices of a named array aggregate, bail out when any choices are marked as Errors_Posted.