exp_ch2.adb (Expand_Entity_Reference): Extend handling of atomic sync to type case.

2011-11-04  Robert Dewar  <dewar@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.

From-SVN: r180938
This commit is contained in:
Robert Dewar 2011-11-04 10:58:44 +00:00 committed by Arnaud Charlet
parent c2d1a4747c
commit fb5d63c68a
3 changed files with 28 additions and 4 deletions

View File

@ -1,3 +1,10 @@
2011-11-04 Robert Dewar <dewar@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.
2011-11-04 Robert Dewar <dewar@adacore.com>
* sem_warn.adb (Warn_On_Useless_Assignment): More accurate test

View File

@ -401,7 +401,9 @@ package body Exp_Ch2 is
-- 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 @@ package body Exp_Ch2 is
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

View File

@ -5465,7 +5465,7 @@ package body Sem_Prag is
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;