diff mbox

[Ada] Further work on atomic synchronization

Message ID 20111104135548.GA15218@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Nov. 4, 2011, 1:55 p.m. UTC
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  <ebotcazou@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.
diff mbox

Patch

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;