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 <dismu...@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.
Index: sem_aggr.adb
===================================================================
--- sem_aggr.adb (revision 177178)
+++ sem_aggr.adb (working copy)
@@ -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
