[multiple changes]

2014-01-31  Robert Dewar  <dewar@adacore.com>

	* gnat_ugn.texi: Minor update.
	* gnat_rm.texi: Add example to Restriction_Warnings documentation.
	* exp_util.adb: Minor reformatting.

2014-01-31  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch9.adb (Expand_Entry_Barrier): Warn if the barrier
	depends on data that is not private to the protected object,
	and potentially modifiable in unsynchronized fashion.

From-SVN: r207357

5 files changed, 98 insertions, 10 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 27d0c3f..b46a2d5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,15 @@
+2014-01-31  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_ugn.texi: Minor update.
+	* gnat_rm.texi: Add example to Restriction_Warnings documentation.
+	* exp_util.adb: Minor reformatting.
+
+2014-01-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch9.adb (Expand_Entry_Barrier): Warn if the barrier
+	depends on data that is not private to the protected object,
+	and potentially modifiable in unsynchronized fashion.
+
 2014-01-31  Yannick Moy  <moy@adacore.com>
 
 	* erroutc.adb (Validate_Specific_Warnings): Remove special case for
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 1f9e05b..9467437 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -6180,10 +6180,60 @@ package body Exp_Ch9 is
                     Condition (Entry_Body_Formal_Part (N));
       Prot      : constant Entity_Id := Scope (Ent);
       Spec_Decl : constant Node_Id   := Parent (Prot);
-      Func      : Node_Id;
+      Func      : Entity_Id;
       B_F       : Node_Id;
       Body_Decl : Node_Id;
 
+      function Is_Global_Entity (N : Node_Id) return Traverse_Result;
+      --  Check whether entity in Barrier is external to protected type.
+      --  If so, barrier may not be properly synchronized.
+
+      ----------------------
+      -- Is_Global_Entity --
+      ----------------------
+
+      function Is_Global_Entity (N : Node_Id) return Traverse_Result is
+         E : Entity_Id;
+         S : Entity_Id;
+      begin
+         if Is_Entity_Name (N) and then Present (Entity (N)) then
+            E := Entity (N);
+            S := Scope  (E);
+
+            if Ekind (E) = E_Variable then
+               if Scope (E) = Func then
+                  null;
+
+               --  A protected call from a barrier to another object is ok
+
+               elsif Ekind (Etype (E)) = E_Protected_Type then
+                  null;
+
+               --  If the variable is within the package body we consider
+               --  this safe. This is a common (if dubious) idiom.
+
+               elsif S = Scope (Prot)
+                 and then (Ekind (S) = E_Package
+                   or else Ekind (S) = E_Generic_Package)
+                 and then Nkind (Parent (E)) = N_Object_Declaration
+                 and then Nkind (Parent (Parent (E))) = N_Package_Body
+               then
+                  null;
+
+               else
+                  Error_Msg_N ("potentially unsynchronized barrier ?", N);
+                  Error_Msg_N ("!& should be private component of type?", N);
+               end if;
+            end if;
+         end if;
+
+         return OK;
+      end Is_Global_Entity;
+
+      procedure Check_Unprotected_Barrier is
+         new Traverse_Proc (Is_Global_Entity);
+      --  Start of processing for Expand_Entry_Barrier
+
    begin
       if No_Run_Time_Mode then
          Error_Msg_CRT ("entry barrier", N);
@@ -6268,8 +6318,11 @@ package body Exp_Ch9 is
       end if;
 
       --  It is not a boolean variable or literal, so check the restriction
+      --  and otherwise emit warning if barrier contains global entities and
+      --  is thus potentially unsynchronized.
 
       Check_Restriction (Simple_Barriers, Cond);
+      Check_Unprotected_Barrier (Cond);
    end Expand_Entry_Barrier;
 
    ------------------------------
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index c79c067..7c1c75c 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -523,9 +523,9 @@ package body Exp_Util is
                --  the expander introduces several levels of address arithmetic
                --  to perform dispatch table displacement. In this scenario the
                --  object appears as:
-               --
+
                --    Tag_Ptr (Base_Address (<object>'Address))
-               --
+
                --  Detect this case and utilize the whole expression as the
                --  "object" since it now points to the proper dispatch table.
 
@@ -831,8 +831,9 @@ package body Exp_Util is
                  and then Is_Type (Entity (Temp))
                then
                   Flag_Expr :=
-                    New_Reference_To (Boolean_Literals
-                      (Needs_Finalization (Entity (Temp))), Loc);
+                    New_Reference_To
+                      (Boolean_Literals
+                         (Needs_Finalization (Entity (Temp))), Loc);
 
                --  The allocation / deallocation of a class-wide object relies
                --  on a runtime check to determine whether the object is truly
@@ -844,11 +845,11 @@ package body Exp_Util is
 
                   --  Detect a special case where interface class-wide types
                   --  are involved as the object appears as:
-                  --
+
                   --    Tag_Ptr (Base_Address (<object>'Address))
-                  --
+
                   --  The expression already yields the proper tag, generate:
-                  --
+
                   --    Temp.all
 
                   if Is_RTE (Etype (Temp), RE_Tag_Ptr) then
@@ -858,7 +859,7 @@ package body Exp_Util is
 
                   --  In the default case, obtain the tag of the object about
                   --  to be allocated / deallocated. Generate:
-                  --
+
                   --    Temp'Tag
 
                   else
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index abb0038..19e22ce 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6026,6 +6026,26 @@ the compiler checks for violations of the restriction, but
 generates a warning message rather than an error message
 if the restriction is violated.
 
+One use of this is in situations where you want to know
+about violations of a restriction, but you want to ignore some of
+these violations. Consider this example, where you want to set
+Ada_95 mode and enable style checks, but you want to know about
+any other use of implementation pragmas:
+
+@smallexample @c ada
+pragma Restriction_Warnings (No_Implementation_Pragmas);
+pragma Warnings (Off, "violation of*No_Implementation_Pragmas*");
+pragma Ada_95;
+pragma Style_Checks ("2bfhkM160");
+pragma Warnings (On, "violation of*No_Implementation_Pragmas*");
+@end smallexample
+
+@noindent
+By including the above lines in a configuration pragmas file,
+the Ada_95 and Style_Checks pragmas are accepted without
+generating a warning, but any other use of implementation
+defined pragmas will cause a warning to be generated.
+
 @node Pragma Share_Generic
 @unnumberedsec Pragma Share_Generic
 @findex Share_Generic
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index b6d05cd..af3d2c2 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -15262,7 +15262,7 @@ Options:
 -mdir -- generate one .xml file for each Ada source file, in directory
          @file{dir}. (Default is to generate the XML to standard output.)
 
--q -- debugging version, with interspersed source, and a more
+--compact -- debugging version, with interspersed source, and a more
       compact representation of "sloc". This version does not conform
       to any schema.
 
@@ -15270,6 +15270,8 @@ Options:
     directories to search for dependencies
     You can also set the ADA_INCLUDE_PATH environment variable for this.
 
+-q -- quiet
+
 -v -- verbose (print out the command line options, and the names of
       output files as they are generated).