This patch fixes regressions caused by the previous checkin to
handle statically predicated subtypes in variant choices. Error
messages were not being given in full code generation mode.
The following should compile with the indicated errors in both
-gnatc and normal code generation mode.
1. PROCEDURE Variant_Errors IS
2. SUBTYPE STATCHAR IS CHARACTER RANGE 'I' .. 'N';
3. TYPE REC1 (DISC : STATCHAR) IS
4. RECORD
5. CASE DISC IS
|
>>> missing case value: 'K'
>>> missing case value: 'N'
6. WHEN 'I' => NULL;
7. WHEN 'J' => NULL;
8. WHEN 'L' => NULL;
9. WHEN 'M' => NULL;
10. END CASE;
11. END RECORD;
12. BEGIN
13. NULL;
14. end Variant_Errors;
Note: this is abstracted from ACATS test B37309B
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-10-10 Robert Dewar <de...@adacore.com>
* exp_ch3.adb (Expand_N_Variant_Part): Now null, expansion of
last choice to others is moved to Freeze_Record_Type.
* freeze.adb (Freeze_Record_Type): Expand last variant to others
if necessary (moved here from Expand_N_Variant_Part
Index: freeze.adb
===================================================================
--- freeze.adb (revision 203358)
+++ freeze.adb (working copy)
@@ -2639,7 +2639,7 @@
C : Node_Id;
V : Node_Id;
- Others_Present : Boolean;
+ Others_Present : Boolean;
pragma Warnings (Off, Others_Present);
-- Indicates others present, not used in this case
@@ -2748,12 +2748,38 @@
end if;
end if;
- -- If we have a variant part, check choices
+ -- Case of variant part present
if Present (C) and then Present (Variant_Part (C)) then
V := Variant_Part (C);
+
+ -- Check choices
+
Check_Choices
(V, Variants (V), Etype (Name (V)), Others_Present);
+
+ -- If the last variant does not contain the Others choice,
+ -- replace it with an N_Others_Choice node since Gigi always
+ -- wants an Others. Note that we do not bother to call Analyze
+ -- on the modified variant part, since its only effect would be
+ -- to compute the Others_Discrete_Choices node laboriously, and
+ -- of course we already know the list of choices corresponding
+ -- to the others choice (it's the list we're replacing!)
+
+ declare
+ Last_Var : constant Node_Id :=
+ Last_Non_Pragma (Variants (V));
+ Others_Node : Node_Id;
+ begin
+ if Nkind (First (Discrete_Choices (Last_Var))) /=
+ N_Others_Choice
+ then
+ Others_Node := Make_Others_Choice (Sloc (Last_Var));
+ Set_Others_Discrete_Choices
+ (Others_Node, Discrete_Choices (Last_Var));
+ Set_Discrete_Choices (Last_Var, New_List (Others_Node));
+ end if;
+ end;
end if;
end Check_Variant_Part;
end Freeze_Record_Type;
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 203358)
+++ exp_ch3.adb (working copy)
@@ -5846,31 +5846,18 @@
-- Expand_N_Variant_Part --
---------------------------
- procedure Expand_N_Variant_Part (N : Node_Id) is
- Last_Var : constant Node_Id := Last_Non_Pragma (Variants (N));
- Others_Node : Node_Id;
+ -- Note: this procedure no longer has any effect. It used to be that we
+ -- would replace the choices in the last variant by a when others, and
+ -- also expanded static predicates in variant choices here, but both of
+ -- those activities were being done too early, since we can't check the
+ -- choices until the statically predicated subtypes are frozen, which can
+ -- happen as late as the free point of the record, and we can't change the
+ -- last choice to an others before checking the choices, which is now done
+ -- at the freeze point of the record.
+ procedure Expand_N_Variant_Part (N : Node_Id) is
begin
- -- If the last variant does not contain the Others choice, replace it
- -- with an N_Others_Choice node since Gigi always wants an Others. Note
- -- that we do not bother to call Analyze on the modified variant part,
- -- since its only effect would be to compute the Others_Discrete_Choices
- -- node laboriously, and of course we already know the list of choices
- -- corresponding to the others choice (it's the list we're replacing!)
-
- if Nkind (First (Discrete_Choices (Last_Var))) /= N_Others_Choice then
- Others_Node := Make_Others_Choice (Sloc (Last_Var));
- Set_Others_Discrete_Choices
- (Others_Node, Discrete_Choices (Last_Var));
- Set_Discrete_Choices (Last_Var, New_List (Others_Node));
- end if;
-
- -- We have one more expansion activity, which is to deal with static
- -- predicates in the variant choices. But we have to defer that to
- -- the freeze point, because the statically predicated subtype won't
- -- be fully processed till then, so this expansion activity is carried
- -- out in Freeze_Record_Type.
-
+ null;
end Expand_N_Variant_Part;
---------------------------------
