[multiple changes]

2011-11-04  Yannick Moy  <moy@adacore.com>

	* sem_prag.adb: Minor refactoring (renaming of a parameter).

2011-11-04  Robert Dewar  <dewar@adacore.com>

	* atree.ads: Minor reformatting.

2011-11-04  Robert Dewar  <dewar@adacore.com>

	* checks.adb (Atomic_Synchronization_Disabled): Check -gnatd.d
	and -gnatd.e here
	* exp_ch2.adb (Expand_Entity_Reference): Use
	Activate_Atomic_Synchronization
	* exp_ch4.adb (Expand_N_Explicit_Dereference): Use
	Activate_Atomic_Synchronization (Expand_N_Indexed_Compoonent):
	Activate_Atomic_Synchronization (Expand_N_Selected_Component):
	Use Activate_Atomic_Synchronization
	* exp_util.ads, exp_util.adb (Activate_Atomic_Synchronization): New
	procedure.
	* sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now apply to
	N_Selected_Component node

From-SVN: r180950

10 files changed, 125 insertions, 83 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ba5cdd8..8742031 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2011-11-04  Yannick Moy  <moy@adacore.com>
+
+	* sem_prag.adb: Minor refactoring (renaming of a parameter).
+
+2011-11-04  Robert Dewar  <dewar@adacore.com>
+
+	* atree.ads: Minor reformatting.
+
+2011-11-04  Robert Dewar  <dewar@adacore.com>
+
+	* checks.adb (Atomic_Synchronization_Disabled): Check -gnatd.d
+	and -gnatd.e here
+	* exp_ch2.adb (Expand_Entity_Reference): Use
+	Activate_Atomic_Synchronization
+	* exp_ch4.adb (Expand_N_Explicit_Dereference): Use
+	Activate_Atomic_Synchronization (Expand_N_Indexed_Compoonent):
+	Activate_Atomic_Synchronization (Expand_N_Selected_Component):
+	Use Activate_Atomic_Synchronization
+	* exp_util.ads, exp_util.adb (Activate_Atomic_Synchronization): New
+	procedure.
+	* sinfo.ads, sinfo.adb (Atomic_Sync_Required): Can now apply to
+	N_Selected_Component node
+
 2011-11-04  Robert Dewar  <dewar@adacore.com>
 
 	* sem_prag.adb, atree.ads, prj-env.adb, prj-env.ads: Minor reformatting.
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index 736f5ca..6bb9ddd 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -895,9 +895,13 @@ package Atree is
    -----------------------------------
 
    --  This subpackage provides the functions for accessing and procedures for
-   --  setting fields that are normally referenced by their logical synonyms
-   --  defined in packages Sinfo and Einfo. The implementations of these
-   --  packages use the package Atree.Unchecked_Access.
+   --  setting fields that are normally referenced by wrapper subprograms (e.g.
+   --  logical synonyms defined in packages Sinfo and Einfo, or specialized
+   --  routines such as Rewrite (for Original_Node), or the node creation
+   --  routines (for Set_Nkind). The implementations of these wrapper
+   --  subprograms use the package Atree.Unchecked_Access as do various
+   --  special case accesses where no wrapper applies. Documentation is always
+   --  required for such a special case access explaining why it is needed.
 
    package Unchecked_Access is
 
diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb
index f323486..67febfe 100644
--- a/gcc/ada/checks.adb
+++ b/gcc/ada/checks.adb
@@ -2565,8 +2565,25 @@ package body Checks is
 
    function Atomic_Synchronization_Disabled (E : Entity_Id) return Boolean is
    begin
-      if Present (E) and then Checks_May_Be_Suppressed (E) then
+      --  If debug flag d.e is set, always return False, i.e. all atomic sync
+      --  looks enabled, since it is never disabled.
+
+      if Debug_Flag_Dot_E then
+         return False;
+
+      --  If debug flag d.d is set then always return True, i.e. all atomic
+      --  sync looks disabled, since it always tests True.
+
+      elsif Debug_Flag_Dot_D then
+         return True;
+
+      --  If entity present, then check result for that entity
+
+      elsif Present (E) and then Checks_May_Be_Suppressed (E) then
          return Is_Check_Suppressed (E, Atomic_Synchronization);
+
+      --  Otherwise result depends on current scope setting
+
       else
          return Scope_Suppress (Atomic_Synchronization);
       end if;
diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb
index 9726563..80f381b 100644
--- a/gcc/ada/exp_ch2.adb
+++ b/gcc/ada/exp_ch2.adb
@@ -404,35 +404,15 @@ package body Exp_Ch2 is
       if Nkind_In (N, N_Identifier, N_Expanded_Name)
         and then Ekind (E) = E_Variable
         and then (Is_Atomic (E) or else Is_Atomic (Etype (E)))
-
-         --  Don't go setting the flag for the prefix of an attribute because
-         --  we don't want atomic sync for X'Size, X'Access etc.
-
-         --  Is this right in all cases of attributes???
-         --  Are there other exemptions required ???
-
-        and then (Nkind (Parent (N)) /= N_Attribute_Reference
-                    or else Prefix (Parent (N)) /= N)
       then
          declare
             Set  : Boolean;
-            MLoc : Node_Id;
 
          begin
-            --  Always set if debug flag d.e is set
-
-            if Debug_Flag_Dot_E then
-               Set := True;
-
-            --  Never set if debug flag d.d is set
-
-            elsif Debug_Flag_Dot_D then
-               Set := False;
-
             --  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
+            if 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
@@ -453,20 +433,7 @@ package body Exp_Ch2 is
             --  Set flag if required
 
             if Set then
-               Set_Atomic_Sync_Required (N);
-
-               --  Generate info message if requested
-
-               if Warn_On_Atomic_Synchronization then
-                  if Nkind (N) = N_Identifier then
-                     MLoc := N;
-                  else
-                     MLoc := Selector_Name (N);
-                  end if;
-
-                  Error_Msg_N
-                    ("?info: atomic synchronization set for &", MLoc);
-               end if;
+               Activate_Atomic_Synchronization (N);
             end if;
          end;
       end if;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 671c283..b056d114 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -4478,13 +4478,7 @@ package body Exp_Ch4 is
       if Is_Atomic (Etype (N))
         and then not Atomic_Synchronization_Disabled (Etype (N))
       then
-         Set_Atomic_Sync_Required (N);
-
-         --  Generate info message if requested
-
-         if Warn_On_Atomic_Synchronization then
-            Error_Msg_N ("?info: atomic synchronization set", N);
-         end if;
+         Activate_Atomic_Synchronization (N);
       end if;
    end Expand_N_Explicit_Dereference;
 
@@ -5326,13 +5320,7 @@ package body Exp_Ch4 is
         or else (Is_Atomic (Typ)
                   and then not Atomic_Synchronization_Disabled (Typ))
       then
-         Set_Atomic_Sync_Required (N);
-
-         --  Generate info message if requested
-
-         if Warn_On_Atomic_Synchronization then
-            Error_Msg_N ("?info: atomic synchronization set", N);
-         end if;
+         Activate_Atomic_Synchronization (N);
       end if;
 
       --  All done for the non-packed case
@@ -8216,14 +8204,7 @@ package body Exp_Ch4 is
         and then Is_Atomic (Etype (N))
         and then not Atomic_Synchronization_Disabled (Etype (N))
       then
-         Set_Atomic_Sync_Required (Selector_Name (N));
-
-         --  Generate info message if requested
-
-         if Warn_On_Atomic_Synchronization then
-            Error_Msg_N
-              ("?info: atomic synchronization set for &", Selector_Name (N));
-         end if;
+         Activate_Atomic_Synchronization (N);
       end if;
    end Expand_N_Selected_Component;
 
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index dd58b01..0f7fe59 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -160,6 +160,53 @@ package body Exp_Util is
    --  or body. Flag Nested_Constructs should be set when any nested packages
    --  declared in L must be processed.
 
+   -------------------------------------
+   -- Activate_Atomic_Synchronization --
+   -------------------------------------
+
+   procedure Activate_Atomic_Synchronization (N : Node_Id) is
+      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;
+
+      --  Go ahead and set the flag
+
+      Set_Atomic_Sync_Required (N);
+
+      --  Generate info message if requested
+
+      if Warn_On_Atomic_Synchronization then
+         case Nkind (N) is
+            when N_Identifier =>
+               Msg_Node := N;
+
+            when N_Selected_Component | N_Expanded_Name =>
+               Msg_Node := Selector_Name (N);
+
+            when N_Explicit_Dereference | N_Indexed_Component =>
+               Msg_Node := Empty;
+
+            when others =>
+               pragma Assert (False);
+               return;
+         end case;
+
+         if Present (Msg_Node) then
+            Error_Msg_N ("?info: atomic synchronization set for &", Msg_Node);
+         else
+            Error_Msg_N ("?info: atomic synchronization set", N);
+         end if;
+      end if;
+   end Activate_Atomic_Synchronization;
+
    ----------------------
    -- Adjust_Condition --
    ----------------------
diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 1f0ee42..94512b6 100644
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -149,6 +149,14 @@ package Exp_Util is
    -- Other Subprograms --
    -----------------------
 
+   procedure Activate_Atomic_Synchronization (N : Node_Id);
+   --  N is a node for which atomic synchronization may be required (it is
+   --  either an identifier, expanded name, or selected/indexed component or
+   --  an explicit dereference). The caller has checked the basic conditions
+   --  (atomic variable appearing and Atomic_Sync not disabled). This function
+   --  checks if atomic synchronization is required and if so sets the flag
+   --  and if appropriate generates a warning (in -gnatw.n mode).
+
    procedure Adjust_Condition (N : Node_Id);
    --  The node N is an expression whose root-type is Boolean, and which
    --  represents a boolean value used as a condition (i.e. a True/False
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index df897e6..f8562ba 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -528,9 +528,9 @@ package body Sem_Prag is
       --  case, and if found, issues an appropriate error message.
 
       procedure Check_Expr_Is_Static_Expression
-        (Argx : Node_Id;
+        (Expr : Node_Id;
          Typ  : Entity_Id := Empty);
-      --  Check the specified expression Argx to make sure that it is a static
+      --  Check the specified expression Expr to make sure that it is a static
       --  expression of the given type (i.e. it will be analyzed and resolved
       --  using this type, which can be any valid argument to Resolve, e.g.
       --  Any_Integer is OK). If not, given error and raise Pragma_Exit. If
@@ -1456,20 +1456,20 @@ package body Sem_Prag is
       -------------------------------------
 
       procedure Check_Expr_Is_Static_Expression
-        (Argx : Node_Id;
+        (Expr : Node_Id;
          Typ  : Entity_Id := Empty)
       is
       begin
          if Present (Typ) then
-            Analyze_And_Resolve (Argx, Typ);
+            Analyze_And_Resolve (Expr, Typ);
          else
-            Analyze_And_Resolve (Argx);
+            Analyze_And_Resolve (Expr);
          end if;
 
-         if Is_OK_Static_Expression (Argx) then
+         if Is_OK_Static_Expression (Expr) then
             return;
 
-         elsif Etype (Argx) = Any_Type then
+         elsif Etype (Expr) = Any_Type then
             raise Pragma_Exit;
 
          --  An interesting special case, if we have a string literal and we
@@ -1479,14 +1479,14 @@ package body Sem_Prag is
          --  warnings as usual, but will not cause errors.
 
          elsif Ada_Version = Ada_83
-           and then Nkind (Argx) = N_String_Literal
+           and then Nkind (Expr) = N_String_Literal
          then
             return;
 
          --  Static expression that raises Constraint_Error. This has already
          --  been flagged, so just exit from pragma processing.
 
-         elsif Is_Static_Expression (Argx) then
+         elsif Is_Static_Expression (Expr) then
             raise Pragma_Exit;
 
          --  Finally, we have a real error
@@ -1499,7 +1499,7 @@ package body Sem_Prag is
                        "argument for pragma% must be a static expression!";
             begin
                Fix_Error (Msg);
-               Flag_Non_Static_Expr (Msg, Argx);
+               Flag_Non_Static_Expr (Msg, Expr);
             end;
 
             raise Pragma_Exit;
diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb
index f6ea4b1..b36b930 100644
--- a/gcc/ada/sinfo.adb
+++ b/gcc/ada/sinfo.adb
@@ -256,7 +256,8 @@ package body Sinfo is
         or else NT (N).Nkind = N_Expanded_Name
         or else NT (N).Nkind = N_Explicit_Dereference
         or else NT (N).Nkind = N_Identifier
-        or else NT (N).Nkind = N_Indexed_Component);
+        or else NT (N).Nkind = N_Indexed_Component
+        or else NT (N).Nkind = N_Selected_Component);
       return Flag14 (N);
    end Atomic_Sync_Required;
 
@@ -3327,7 +3328,8 @@ package body Sinfo is
         or else NT (N).Nkind = N_Expanded_Name
         or else NT (N).Nkind = N_Explicit_Dereference
         or else NT (N).Nkind = N_Identifier
-        or else NT (N).Nkind = N_Indexed_Component);
+        or else NT (N).Nkind = N_Indexed_Component
+        or else NT (N).Nkind = N_Selected_Component);
       Set_Flag14 (N, Val);
    end Set_Atomic_Sync_Required;
 
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index dce0c2d..35a73f9a 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -606,16 +606,8 @@ package Sinfo is
    --    harmless.
 
    --  Atomic_Sync_Required (Flag14-Sem)
-   --    This flag is set in an identifier or expanded name node if the
-   --    corresponding reference (or assignment when on the left side of
-   --    an assignment) requires atomic synchronization, as a result of
-   --    Atomic_Synchronization being enabled for the corresponding entity
-   --    or its type. Also set for Selector_Name of an N_Selected Component
-   --    node if the type is atomic and requires atomic synchronization.
-   --    Also set on an N_Explicit Dereference node if the resulting type
-   --    is atomic and requires atomic synchronization. Finally it is set
-   --    on an N_Indexed_Component node if the resulting type is Atomic, or
-   --    if the array type or the array has pragma Atomic_Components set.
+   --    This flag is set on a node for which atomic synchronization is
+   --    required for the corresponding reference or modification.
 
    --  At_End_Proc (Node1)
    --    This field is present in an N_Handled_Sequence_Of_Statements node.
@@ -3248,6 +3240,7 @@ package Sinfo is
       --  Associated_Node (Node4-Sem)
       --  Do_Discriminant_Check (Flag13-Sem)
       --  Is_In_Discriminant_Check (Flag11-Sem)
+      --  Atomic_Sync_Required (Flag14-Sem)
       --  plus fields for expression
 
       --------------------------