This makes the compiler detect one more case needing atomic synchronization,
namely a pragma Atomic on a component with a predefined type. And this also
excludes a few more cases not needing it.
The compiler should issue the warning with -gnatw.n -gnatld7 -gnatj60 on:
procedure Synccomp is
type R is record
I : Integer;
pragma Atomic (I);
end record;
Rec : R;
begin
Rec.I := 1;
end;
for Rec.I in the assignment.
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-11-04 Eric Botcazou <ebotca...@adacore.com>
* exp_ch4.adb (Expand_N_Selected_Component): Refine code
setting the Atomic_Sync_Required flag to detect one more case.
* exp_util.adb (Activate_Atomic_Synchronization): Refine code
setting the Atomic_Sync_Required flag to exclude more cases,
depending on the parent of the node to be examined.
Index: exp_util.adb
===================================================================
--- exp_util.adb (revision 180951)
+++ exp_util.adb (working copy)
@@ -168,15 +168,31 @@
Msg_Node : Node_Id;
begin
- -- Nothing to do if we are the prefix of an attribute, since we do not
- -- want an atomic sync operation for things like A'Adress or A'Size).
- if Nkind (Parent (N)) = N_Attribute_Reference
- and then Prefix (Parent (N)) = N
- then
- return;
- end if;
+ case Nkind (Parent (N)) is
+ when N_Attribute_Reference |
+ -- Nothing to do if we are the prefix of an attribute, since we
+ -- do not want an atomic sync operation for things like 'Size.
+
+ N_Reference |
+
+ -- Likewise for a mere reference
+
+ N_Indexed_Component |
+ N_Selected_Component |
+ N_Slice =>
+
+ -- The C.6(15) clause says that only reads and updates of the
+ -- object as a whole require atomic synchronization.
+
+ if Prefix (Parent (N)) = N then
+ return;
+ end if;
+
+ when others => null;
+ end case;
+
-- Go ahead and set the flag
Set_Atomic_Sync_Required (N);
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb (revision 180950)
+++ exp_ch4.adb (working copy)
@@ -8196,15 +8196,44 @@
Analyze (N);
end if;
- -- If we still have a selected component, and the type is an Atomic
- -- type for which Atomic_Sync is enabled, then we set the atomic sync
- -- flag on the selector.
+ -- Set Atomic_Sync_Required if necessary for atomic component
- if Nkind (N) = N_Selected_Component
- and then Is_Atomic (Etype (N))
- and then not Atomic_Synchronization_Disabled (Etype (N))
- then
- Activate_Atomic_Synchronization (N);
+ if Nkind (N) = N_Selected_Component then
+ declare
+ E : constant Entity_Id := Entity (Selector_Name (N));
+ Set : Boolean;
+
+ begin
+ -- If component is atomic, but type is not, setting depends on
+ -- disable/enable state for the component.
+
+ if Is_Atomic (E) and then not Is_Atomic (Etype (E)) then
+ Set := not Atomic_Synchronization_Disabled (E);
+
+ -- If component 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));
+
+ -- If both component and type are atomic, we disable if either
+ -- component or its type have sync disabled.
+
+ elsif Is_Atomic (E) and then Is_Atomic (Etype (E)) then
+ Set := (not Atomic_Synchronization_Disabled (E))
+ and then
+ (not Atomic_Synchronization_Disabled (Etype (E)));
+
+ else
+ Set := False;
+ end if;
+
+ -- Set flag if required
+
+ if Set then
+ Activate_Atomic_Synchronization (N);
+ end if;
+ end;
end if;
end Expand_N_Selected_Component;
