This patch adds code to the semantic analyzer to properly check
that entry family bounds are in range. Previously this check was
done during code expansion, leading to messages posted at the
wrong point, omission of the check in -gnatc mode, and in the
case of task entry families a blow up in the expander.
The following tests compile with the errors shown in
both normal and -gnatc modes.
1. procedure badentrymsg is
2. protected type PT is
3. entry Test (Long_Long_Integer)
|
>>> entry family low bound must be >= 0
>>> entry family high bound must be <= 16#7FFF_FFFF#
4. (X : Integer);
5. private
6. Data : Integer := 0;
7. end PT;
8.
9. protected body PT is
10. entry Test
11. (for I in Long_Long_Integer)
12. (X : Integer)
13. when True is
14. begin
15. Data := X;
16. end Test;
17. end PT;
18. PO : PT;
19. begin
20. PO.Test(3)(5);
21. end;
1. procedure badtaskentry is
2. Data : Integer;
3. task type PT is
4. entry Test (Long_Long_Integer)
|
>>> entry family low bound must be >= 0
>>> entry family high bound must be <= 16#7FFF_FFFF#
5. (X : Integer);
6. end PT;
7.
8. task body PT is
9. begin
10. accept Test (3) (X : Integer) do
11. Data := X;
12. end Test;
13. end PT;
14.
15. T : PT;
16. begin
17. null;
18. end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-23 Robert Dewar <de...@adacore.com>
* sem_ch9.adb (Analyze_Entry_Declaration): Check for entry
family bounds out of range.
Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb (revision 181654)
+++ sem_ch9.adb (working copy)
@@ -905,6 +905,60 @@
Bad_Predicated_Subtype_Use
("subtype& has predicate, not allowed in entry family",
D_Sdef, Etype (D_Sdef));
+
+ -- Check entry family static bounds outside allowed limits
+
+ -- Note: originally this check was not performed here, but in that
+ -- case the check happens deep in the expander, and the message is
+ -- posted at the wrong location, and omitted in -gnatc mode.
+
+ declare
+ PEI : constant Entity_Id := RTE (RE_Protected_Entry_Index);
+ LB : constant Uint := Expr_Value (Type_Low_Bound (PEI));
+ UB : constant Uint := Expr_Value (Type_High_Bound (PEI));
+
+ LBR : Node_Id;
+ UBR : Node_Id;
+
+ begin
+ if Nkind (D_Sdef) = N_Range then
+ LBR := Low_Bound (D_Sdef);
+ elsif Is_Entity_Name (D_Sdef)
+ and then Is_Type (Entity (D_Sdef))
+ then
+ LBR := Type_Low_Bound (Entity (D_Sdef));
+ else
+ goto Skip_LB;
+ end if;
+
+ if Is_Static_Expression (LBR)
+ and then Expr_Value (LBR) < LB
+ then
+ Error_Msg_Uint_1 := LB;
+ Error_Msg_N ("entry family low bound must be '>'= ^!", D_Sdef);
+ end if;
+
+ <<Skip_LB>>
+ if Nkind (D_Sdef) = N_Range then
+ UBR := High_Bound (D_Sdef);
+ elsif Is_Entity_Name (D_Sdef)
+ and then Is_Type (Entity (D_Sdef))
+ then
+ UBR := Type_High_Bound (Entity (D_Sdef));
+ else
+ goto Skip_UB;
+ end if;
+
+ if Is_Static_Expression (UBR)
+ and then Expr_Value (UBR) > UB
+ then
+ Error_Msg_Uint_1 := UB;
+ Error_Msg_N ("entry family high bound must be '<'= ^!", D_Sdef);
+ end if;
+
+ <<Skip_UB>>
+ null;
+ end;
end if;
-- Decorate Def_Id
