* [Ada] Check that Storage_Pool/Storage_Size not both given for same entity
@ 2014-01-22 15:41 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2014-01-22 15:41 UTC (permalink / raw)
To: gcc-patches; +Cc: Robert Dewar
[-- Attachment #1: Type: text/plain, Size: 4652 bytes --]
This patch implements fully the rule of 13.11(3) that forbids having both
a Storage_Pool and Storage_Size attribute specified for the same type, as
shown by the following example:
1. with System.Storage_Elements; use System.Storage_Elements;
2. with System.Storage_Pools; use System.Storage_Pools;
3.
4. package Pool is
5. type Pool_Element is record
6. Element : Storage_Element;
7. end record;
8.
9. type Contents_Array is
10. array (Storage_Offset range <>) of Pool_Element;
11.
12. type My_Pool (Size : Storage_Offset) is
13. new Root_Storage_Pool with record
14. Contents : Contents_Array (1 .. Size);
15. end record;
16.
17. overriding procedure Allocate
18. (Pool : in out My_Pool;
19. Storage_Address : out System.Address;
20. Size_In_Storage_Elements : Storage_Count;
21. Alignment : Storage_Count);
22.
23. overriding procedure Deallocate
24. (Pool : in out My_Pool;
25. Storage_Address : System.Address;
26. Size_In_Storage_Elements : Storage_Count;
27. Alignment : Storage_Count);
28.
29. overriding function Storage_Size
30. (Pool: My_Pool) return Storage_Count
31. is (Pool.Size);
32. end Pool;
1. package body Pool is
2. procedure Allocate
3. (Pool : in out My_Pool;
4. Storage_Address : out System.Address;
5. Size_In_Storage_Elements : Storage_Count;
6. Alignment : Storage_Count)
7. is
8. pragma Unreferenced
9. (Pool, Storage_Address,
10. Size_In_Storage_Elements, Alignment);
11. begin
12. null;
13. end Allocate;
14.
15. procedure Deallocate
16. (Pool : in out My_Pool;
17. Storage_Address : in System.Address;
18. Size_In_Storage_Elements : Storage_Count;
19. Alignment : Storage_Count)
20. is
21. pragma Unreferenced
22. (Pool, Storage_Address,
23. Size_In_Storage_Elements, Alignment);
24. begin
25. null;
26. end Deallocate;
27. end Pool;
1. with Pool; use Pool;
2.
3. package Mix_Of_Attributes is
4. Pool : My_Pool (16);
5.
6. type Rec is record
7. Comp : Integer := 123;
8. end record;
9.
10. type Ptr_1 is access all Rec;
11. for Ptr_1'Storage_Size use 16;
12. for Ptr_1'Storage_Pool use Pool;
|
>>> Storage_Size previously given for "Ptr_1" at line 11
>>> cannot have Storage_Size and Storage_Pool (RM 13.11(3))
13.
14. type Ptr_2 is access all Rec;
15. for Ptr_2'Storage_Pool use Pool;
16. for Ptr_2'Storage_Size use 16;
|
>>> Storage_Pool previously given for "Ptr_2" at line 15
>>> cannot have Storage_Size and Storage_Pool (RM 13.11(3))
17.
18. type Ptr_3 is access all Rec with Storage_Pool => Pool;
19. for Ptr_3'Storage_Size use 16;
|
>>> Storage_Pool previously given for "Ptr_3" at line 18
>>> cannot have Storage_Size and Storage_Pool (RM 13.11(3))
20.
21. type Ptr_4 is access all Rec with Storage_Size => 16;
22. for Ptr_4'Storage_Pool use Pool;
|
>>> Storage_Size previously given for "Ptr_4" at line 21
>>> cannot have Storage_Size and Storage_Pool (RM 13.11(3))
23.
24. type Ptr_5 is access all Rec
25. with Storage_Pool => Pool,
26. Storage_Size => 16;
|
>>> Storage_Pool previously given for "Ptr_5" at line 25
>>> cannot have Storage_Size and Storage_Pool (RM 13.11(3))
27.
28. type Ptr_6 is access all Rec
29. with Storage_Size => 16,
30. Storage_Pool => Pool;
|
>>> Storage_Size previously given for "Ptr_6" at line 29
>>> cannot have Storage_Size and Storage_Pool (RM 13.11(3))
31.
32. end Mix_Of_Attributes;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-01-22 Robert Dewar <dewar@adacore.com>
* sem_ch13.adb (Check_Pool_Size_Clash): New procedure
(Analyze_Attribute_Definition_Clause, case Storage_Pool): call
Check_Pool_Size_Clash (Analyze_Attribute_Definition_Clause,
case Storage_Size): call Check_Pool_Size_Clash.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 4316 bytes --]
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 206918)
+++ sem_ch13.adb (working copy)
@@ -112,6 +112,10 @@
-- list is stored in Static_Predicate (Typ), and the Expr is rewritten as
-- a canonicalized membership operation.
+ procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id);
+ -- Called if both Storage_Pool and Storage_Size attribute definition
+ -- clauses (SP and SS) are present for entity Ent. Issue error message.
+
procedure Freeze_Entity_Checks (N : Node_Id);
-- Called from Analyze_Freeze_Entity and Analyze_Generic_Freeze Entity
-- to generate appropriate semantic checks that are delayed until this
@@ -1698,8 +1702,8 @@
end if;
-- If the type is private, indicate that its completion
- -- has a freeze node, because that is the one that will be
- -- visible at freeze time.
+ -- has a freeze node, because that is the one that will
+ -- be visible at freeze time.
if Is_Private_Type (E) and then Present (Full_View (E)) then
Set_Has_Predicates (Full_View (E));
@@ -4629,6 +4633,20 @@
return;
end if;
+ -- Check for Storage_Size previously given
+
+ declare
+ SS : constant Node_Id :=
+ Get_Attribute_Definition_Clause
+ (U_Ent, Attribute_Storage_Size);
+ begin
+ if Present (SS) then
+ Check_Pool_Size_Clash (U_Ent, N, SS);
+ end if;
+ end;
+
+ -- Storage_Pool case
+
if Id = Attribute_Storage_Pool then
Analyze_And_Resolve
(Expr, Class_Wide_Type (RTE (RE_Root_Storage_Pool)));
@@ -4788,11 +4806,22 @@
Analyze_And_Resolve (Expr, Any_Integer);
if Is_Access_Type (U_Ent) then
- if Present (Associated_Storage_Pool (U_Ent)) then
- Error_Msg_N ("storage pool already given for &", Nam);
- return;
- end if;
+ -- Check for Storage_Pool previously given
+
+ declare
+ SP : constant Node_Id :=
+ Get_Attribute_Definition_Clause
+ (U_Ent, Attribute_Storage_Pool);
+
+ begin
+ if Present (SP) then
+ Check_Pool_Size_Clash (U_Ent, SP, N);
+ end if;
+ end;
+
+ -- Special case of for x'Storage_Size use 0
+
if Is_OK_Static_Expression (Expr)
and then Expr_Value (Expr) = 0
then
@@ -8307,6 +8336,33 @@
end if;
end Check_Constant_Address_Clause;
+ ---------------------------
+ -- Check_Pool_Size_Clash --
+ ---------------------------
+
+ procedure Check_Pool_Size_Clash (Ent : Entity_Id; SP, SS : Node_Id) is
+ Post : Node_Id;
+
+ begin
+ -- We need to find out which one came first. Note that in the case of
+ -- aspects mixed with pragmas there are cases where the processing order
+ -- is reversed, which is why we do the check here.
+
+ if Sloc (SP) < Sloc (SS) then
+ Error_Msg_Sloc := Sloc (SP);
+ Post := SS;
+ Error_Msg_NE ("Storage_Pool previously given for&#", Post, Ent);
+
+ else
+ Error_Msg_Sloc := Sloc (SS);
+ Post := SP;
+ Error_Msg_NE ("Storage_Size previously given for&#", Post, Ent);
+ end if;
+
+ Error_Msg_N
+ ("\cannot have Storage_Size and Storage_Pool (RM 13.11(3))", Post);
+ end Check_Pool_Size_Clash;
+
----------------------------------------
-- Check_Record_Representation_Clause --
----------------------------------------
@@ -9580,7 +9636,6 @@
-------------------------------------
procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id) is
-
function Is_Pragma_Or_Corr_Pragma_Present_In_Rep_Item
(Rep_Item : Node_Id) return Boolean;
-- This routine checks if Rep_Item is either a pragma or an aspect
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2014-01-22 15:41 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-01-22 15:41 [Ada] Check that Storage_Pool/Storage_Size not both given for same entity Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).