2013-04-25 Robert Dewar <dewar@adacore.com>

	* gnat_rm.texi: Document Reason argument for pragma Warnings.
	* par-prag.adb: Handle Reason parameter for pragma Warnings.
	* sem_prag.adb (Analyze_Pragma, case Warnings): Allow Reason argument.
	* snames.ads-tmpl (Name_Reason): New name entry.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198295 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 71 insertions, 23 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 35e3d7372bb..3c3d7dbc0ed 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2013-04-25  Robert Dewar  <dewar@adacore.com>
+
+	* gnat_rm.texi: Document Reason argument for pragma Warnings.
+	* par-prag.adb: Handle Reason parameter for pragma Warnings.
+	* sem_prag.adb (Analyze_Pragma, case Warnings): Allow Reason argument.
+	* snames.ads-tmpl (Name_Reason): New name entry.
+
 2013-04-25  Yannick Moy  <moy@adacore.com>
 
 	* exp_spark.adb (Expand_SPARK_N_In): Remove procedure.
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5c1a5475c03..7f3596bdeb5 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -6520,10 +6520,12 @@ implementation in DEC Ada 83.
 Syntax:
 
 @smallexample @c ada
-pragma Warnings (On | Off);
-pragma Warnings (On | Off, LOCAL_NAME);
-pragma Warnings (static_string_EXPRESSION);
-pragma Warnings (On | Off, static_string_EXPRESSION);
+pragma Warnings (On | Off [,REASON]);
+pragma Warnings (On | Off, LOCAL_NAME [,REASON]);
+pragma Warnings (static_string_EXPRESSION [,REASON]);
+pragma Warnings (On | Off, static_string_EXPRESSION [,REASON]);
+
+REASON ::= Reason => static_string_EXPRESSION
 @end smallexample
 
 @noindent
@@ -6531,17 +6533,28 @@ Normally warnings are enabled, with the output being controlled by
 the command line switch.  Warnings (@code{Off}) turns off generation of
 warnings until a Warnings (@code{On}) is encountered or the end of the
 current unit.  If generation of warnings is turned off using this
-pragma, then no warning messages are output, regardless of the
-setting of the command line switches.
+pragma, then some or all of the warning messages are suppressed,
+regardless of the setting of the command line switches.
+
+The @code{Reason} parameter may optionally appear as the last argument
+in any of the forms of this pragma. It is intended purely for the
+purposes of documenting the reason for the @code{Warnings} pragma.
+The compiler will check that the argument is a static string but
+otherwise ignore this argument. Other tools may provide specialized
+processing for this string.
 
-The form with a single argument may be used as a configuration pragma.
+The form with a single argument (or two arguments if Reason present),
+where the first argument is @code{ON} or @code{OFF}
+may be used as a configuration pragma.
 
 If the @var{LOCAL_NAME} parameter is present, warnings are suppressed for
 the specified entity.  This suppression is effective from the point where
 it occurs till the end of the extended scope of the variable (similar to
-the scope of @code{Suppress}).
+the scope of @code{Suppress}). This form cannot be used as a configuration
+pragma.
 
-The form with a single static_string_EXPRESSION argument provides more precise
+The form with a single static_string_EXPRESSION argument (and possible
+reason) provides more precise
 control over which warnings are active. The string is a list of letters
 specifying which warnings are to be activated and which deactivated. The
 code for these letters is the same as the string used in the command
@@ -6549,7 +6562,7 @@ line switch controlling warnings. For a brief summary, use the gnatmake
 command with no arguments, which will generate usage information containing
 the list of warnings switches supported. For
 full details see @ref{Warning Message Control,,, gnat_ugn, @value{EDITION}
-User's Guide}.
+User's Guide}. This form can also be used as a configuration pragma.
 
 @noindent
 The warnings controlled by the `-gnatw' switch are generated by the front end
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 4910cd7ef12..de262094a95 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -17,7 +17,7 @@
 -- for  more details.  You should have  received  a copy of the GNU General --
 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
 -- http://www.gnu.org/licenses for a complete copy of the license.          --
---                                                                          --
+--          War                                                                --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
@@ -1027,8 +1027,15 @@ begin
       --  set well before any semantic analysis is performed. Note that we
       --  ignore this pragma if debug flag -gnatd.i is set.
 
+      --  Also note that the "one argument" case may have two arguments if the
+      --  second one is a reason argument.
+
       when Pragma_Warnings =>
-         if Arg_Count = 1 and then not Debug_Flag_Dot_I then
+         if not Debug_Flag_Dot_I
+           and then (Arg_Count = 1
+                      or else (Arg_Count = 2
+                                and then Chars (Arg2) = Name_Reason))
+         then
             Check_No_Identifier (Arg1);
 
             declare
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c3c2a0ca296..7f5b5512bf1 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3310,13 +3310,11 @@ package body Sem_Prag is
       procedure Check_No_Identifiers is
          Arg_Node : Node_Id;
       begin
-         if Arg_Count > 0 then
-            Arg_Node := Arg1;
-            while Present (Arg_Node) loop
-               Check_No_Identifier (Arg_Node);
-               Next (Arg_Node);
-            end loop;
-         end if;
+         Arg_Node := Arg1;
+         for J in 1 .. Arg_Count loop
+            Check_No_Identifier (Arg_Node);
+            Next (Arg_Node);
+         end loop;
       end Check_No_Identifiers;
 
       ------------------------
@@ -17477,14 +17475,36 @@ package body Sem_Prag is
          -- Warnings --
          --------------
 
-         --  pragma Warnings (On | Off);
-         --  pragma Warnings (On | Off, LOCAL_NAME);
-         --  pragma Warnings (static_string_EXPRESSION);
-         --  pragma Warnings (On | Off, STRING_LITERAL);
+         --  pragma Warnings (On | Off [,REASON]);
+         --  pragma Warnings (On | Off, LOCAL_NAME [,REASON]);
+         --  pragma Warnings (static_string_EXPRESSION [,REASON]);
+         --  pragma Warnings (On | Off, STRING_LITERAL [,REASON]);
+
+         --  REASON ::= Reason => Static_String_Expression
 
          when Pragma_Warnings => Warnings : begin
             GNAT_Pragma;
             Check_At_Least_N_Arguments (1);
+
+            --  See if last argument is labeled Reason. If so, make sure we
+            --  have a static string expression, but otherwise just ignore
+            --  the REASON argument by decreasing Num_Args by 1 (all the
+            --  remaining tests look only at the first Num_Args arguments).
+
+            declare
+               Last_Arg : constant Node_Id :=
+                            Last (Pragma_Argument_Associations (N));
+            begin
+               if Nkind (Last_Arg) = N_Pragma_Argument_Association
+                 and then Chars (Last_Arg) = Name_Reason
+               then
+                  Check_Arg_Is_Static_Expression (Last_Arg, Standard_String);
+                  Arg_Count := Arg_Count - 1;
+               end if;
+            end;
+
+            --  Now proceed with REASON taken care of and eliminated
+
             Check_No_Identifiers;
 
             --  If debug flag -gnatd.i is set, pragma is ignored
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 2e5f42b2106..ef983a7fbea 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -746,6 +746,7 @@ package Snames is
    Name_Optional                       : constant Name_Id := N + $;
    Name_Policy                         : constant Name_Id := N + $;
    Name_Parameter_Types                : constant Name_Id := N + $;
+   Name_Reason                         : constant Name_Id := N + $;
    Name_Reference                      : constant Name_Id := N + $;
    Name_Requires                       : constant Name_Id := N + $;
    Name_Restricted                     : constant Name_Id := N + $;