This patch corrects an oversight in the previous checkin for handling
Atomic_Synchronization. This applies to types as well as to variables.
1. pragma Disable_Atomic_Synchronization;
2. procedure AtSyncT is
3. type Int is new Integer;
4. pragma Atomic (Int);
5. X : Int := 1;
6. Y : Int := 1;
7.
8. pragma Enable_Atomic_Synchronization (Int);
9.
10. begin
11. X := Y;
1 2
>>> info: atomic synchronization set for "X"
>>> info: atomic synchronization set for "Y"
12. AtSyncT.Y := AtSyncT.X;
1 2
>>> info: atomic synchronization set for "Y"
>>> info: atomic synchronization set for "X"
13.
14. declare
15. pragma Disable_Atomic_Synchronization (Int);
16. begin
17. X := Y;
18. end;
19.
20. X := Y;
1 2
>>> info: atomic synchronization set for "X"
>>> info: atomic synchronization set for "Y"
21. end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-04 Robert Dewar <de...@adacore.com>
* exp_ch2.adb (Expand_Entity_Reference): Extend handling of
atomic sync to type case.
* sem_prag.adb (Process_Suppress_Unsuppress): Atomic Sync can
apply to types.
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 180935)
+++ sem_prag.adb (working copy)
@@ -5465,7 +5465,7 @@
and then not Is_Atomic (E)
then
Error_Msg_N
- ("pragma & requires atomic variable",
+ ("pragma & requires atomic type or variable",
Pragma_Identifier (Original_Node (N)));
end if;
Index: exp_ch2.adb
===================================================================
--- exp_ch2.adb (revision 180934)
+++ exp_ch2.adb (working copy)
@@ -401,7 +401,9 @@
-- Set Atomic_Sync_Required if necessary for atomic variable
- if Is_Atomic (E) then
+ if Nkind_In (N, N_Identifier, N_Expanded_Name)
+ and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
+ then
declare
Set : Boolean;
MLoc : Node_Id;
@@ -417,10 +419,25 @@
elsif Debug_Flag_Dot_D then
Set := False;
- -- Otherwise setting comes from Atomic_Synchronization state
+ -- If variable is atomic, but type is not, setting depends on
+ -- disable/enable state for the variable.
+ elsif Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
+ Set := not Atomic_Synchronization_Disabled (E);
+
+ -- If variable is not atomic, but its type is atomic, setting
+ -- depends on disable/enable state for the type.
+
+ elsif not Is_Atomic (E) and then Is_Atomic (Etype (E)) then
+ Set := not Atomic_Synchronization_Disabled (Etype (E));
+
+ -- Else both variable and type are atomic (see outer if), and we
+ -- disable if either variable or its type have sync disabled.
+
else
- Set := not Atomic_Synchronization_Disabled (E);
+ Set := (not Atomic_Synchronization_Disabled (E))
+ and then
+ (not Atomic_Synchronization_Disabled (Etype (E)));
end if;
-- Set flag if required
