[multiple changes]

2014-02-25  Robert Dewar  <dewar@adacore.com>

	* sem_ch3.adb (Array_Type_Declaration): Check for case of using
	type name as index.
	* lib.ads: Minor reformatting.
	* einfo.ads: Minor reformatting.

2014-02-25  Doug Rupp  <rupp@adacore.com>

	* sem_mech.adb (Set_Mechanisms): For convention Fortran on VMS
	use Short_Descriptor(S) as the argument passing mechanism.

2014-02-25  Eric Botcazou  <ebotcazou@adacore.com>

	* sigtramp-ppcvxw.c (CFI_COMMON_REGS): Also include r0.

2014-02-25  Robert Dewar  <dewar@adacore.com>

	* atree.ads (Warnings_Treated_As_Errors): New variable.
	* errout.adb (Error_Msg_Internal): Set Warn_Err flag in
	error object (Initialize): Initialize Warnings_As_Errors_Count
	(Write_Error_Summary): Include count of warnings treated as errors.
	* erroutc.adb (Warning_Treated_As_Error): New function.
	(Matches): Function moved to outer level of package.
	* erroutc.ads (Error_Msg_Object): Add Warn_Err flag.
	(Warning_Treated_As_Error): New function.
	* gnat_rm.texi: Document pragma Treat_Warning_As_Error.
	* opt.adb: Add handling of Warnings_As_Errors_Count[_Config].
	* opt.ads (Config_Switches_Type): Add entry for
	Warnings_As_Errors_Count.
	(Warnings_As_Errors_Count): New variable.
	(Warnings_As_Errors): New array.
	* par-prag.adb: Add dummy entry for Warning_As_Error.
	* sem_prag.adb (Analyze_Pragma): Implement new pragma
	Warning_As_Error.
	* snames.ads-tmpl: Add entries for Warning_As_Error pragma.

From-SVN: r208145

16 files changed, 390 insertions, 127 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2cedac3..8dc578e 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,40 @@
+2014-02-25  Robert Dewar  <dewar@adacore.com>
+
+	* sem_ch3.adb (Array_Type_Declaration): Check for case of using
+	type name as index.
+	* lib.ads: Minor reformatting.
+	* einfo.ads: Minor reformatting.
+
+2014-02-25  Doug Rupp  <rupp@adacore.com>
+
+	* sem_mech.adb (Set_Mechanisms): For convention Fortran on VMS
+	use Short_Descriptor(S) as the argument passing mechanism.
+
+2014-02-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* sigtramp-ppcvxw.c (CFI_COMMON_REGS): Also include r0.
+
+2014-02-25  Robert Dewar  <dewar@adacore.com>
+
+	* atree.ads (Warnings_Treated_As_Errors): New variable.
+	* errout.adb (Error_Msg_Internal): Set Warn_Err flag in
+	error object (Initialize): Initialize Warnings_As_Errors_Count
+	(Write_Error_Summary): Include count of warnings treated as errors.
+	* erroutc.adb (Warning_Treated_As_Error): New function.
+	(Matches): Function moved to outer level of package.
+	* erroutc.ads (Error_Msg_Object): Add Warn_Err flag.
+	(Warning_Treated_As_Error): New function.
+	* gnat_rm.texi: Document pragma Treat_Warning_As_Error.
+	* opt.adb: Add handling of Warnings_As_Errors_Count[_Config].
+	* opt.ads (Config_Switches_Type): Add entry for
+	Warnings_As_Errors_Count.
+	(Warnings_As_Errors_Count): New variable.
+	(Warnings_As_Errors): New array.
+	* par-prag.adb: Add dummy entry for Warning_As_Error.
+	* sem_prag.adb (Analyze_Pragma): Implement new pragma
+	Warning_As_Error.
+	* snames.ads-tmpl: Add entries for Warning_As_Error pragma.
+
 2014-02-25  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* sigtramp.h: Fix minor inaccuracy.
diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads
index de6fd2e8..e51cf88 100644
--- a/gcc/ada/atree.ads
+++ b/gcc/ada/atree.ads
@@ -315,6 +315,10 @@ package Atree is
    --  Number of warnings detected. Initialized to zero at the start of
    --  compilation. Initialized for -gnatVa use, see comment above.
 
+   Warnings_Treated_As_Errors : Nat := 0;
+   --  Number of warnings changed into errors as a result of matching a pattern
+   --  given in a Warning_As_Error configuration pragma.
+
    Configurable_Run_Time_Violations : Nat := 0;
    --  Count of configurable run time violations so far. This is used to
    --  suppress certain cascaded error messages when we know that we may not
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 91f59b4..473e2f1 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -820,10 +820,10 @@ package Einfo is
 --       depends on a private type.
 
 --    Designated_Type (synthesized)
---       Applies to access types. Returns the designated type. Differs
---       from Directly_Designated_Type in that if the access type refers
---       to an incomplete type, and the full type is available, then this
---       full type is returned instead of the incomplete type.
+--       Applies to access types. Returns the designated type. Differs from
+--       Directly_Designated_Type in that if the access type refers to an
+--       incomplete type, and the full type is available, then this full type
+--       is returned instead of the incomplete type.
 
 --    Digits_Value (Uint17)
 --       Defined in floating point types and subtypes and decimal types and
diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 99f100b..76b8cbc 100644
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -690,6 +690,9 @@ package body Errout is
 
       Temp_Msg : Error_Msg_Id;
 
+      Warn_Err : Boolean;
+      --  Set if warning to be treated as error
+
       procedure Handle_Serious_Error;
       --  Internal procedure to do all error message handling for a serious
       --  error message, other than bumping the error counts and arranging
@@ -940,6 +943,7 @@ package body Errout is
           Line     => Get_Physical_Line_Number (Sptr),
           Col      => Get_Column_Number (Sptr),
           Warn     => Is_Warning_Msg,
+          Warn_Err => False, -- reset below
           Warn_Chr => Warning_Msg_Char,
           Style    => Is_Style_Msg,
           Serious  => Is_Serious_Error,
@@ -948,6 +952,21 @@ package body Errout is
           Deleted  => False));
       Cur_Msg := Errors.Last;
 
+      --  Test if warning to be treated as error
+
+      Warn_Err :=
+        Is_Warning_Msg
+          and then (Warning_Treated_As_Error (Msg_Buffer (1 .. Msglen))
+                      or else
+                    Warning_Treated_As_Error (Get_Warning_Tag (Cur_Msg)));
+
+      --  Propagate Warn_Err to this message and preceding continuations
+
+      for J in reverse 1 .. Errors.Last loop
+         Errors.Table (J).Warn_Err := Warn_Err;
+         exit when not Errors.Table (J).Msg_Cont;
+      end loop;
+
       --  If immediate errors mode set, output error message now. Also output
       --  now if the -d1 debug flag is set (so node number message comes out
       --  just before actual error message)
@@ -1498,11 +1517,13 @@ package body Errout is
       Last_Error_Msg := No_Error_Msg;
       Serious_Errors_Detected := 0;
       Total_Errors_Detected := 0;
+      Warnings_Treated_As_Errors := 0;
       Warnings_Detected := 0;
+      Warnings_As_Errors_Count := 0;
       Cur_Msg := No_Error_Msg;
       List_Pragmas.Init;
 
-      --  Initialize warnings table
+      --  Initialize warnings tables
 
       Warnings.Init;
       Specific_Warnings.Init;
@@ -1656,6 +1677,11 @@ package body Errout is
                end if;
 
                Write_Char (')');
+
+            elsif Warnings_Treated_As_Errors /= 0 then
+               Write_Str (" (");
+               Write_Int (Warnings_Treated_As_Errors);
+               Write_Str (" treated as errors)");
             end if;
          end if;
 
diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index e44d5f6..5c72532 100644
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -45,6 +45,15 @@ with Uintp;    use Uintp;
 
 package body Erroutc is
 
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   function Matches (S : String; P : String) return Boolean;
+   --  Returns true if the String S patches the pattern P, which can contain
+   --  wild card chars (*). The entire pattern must match the entire string.
+   --  Case is ignored in the comparison (so X matches x).
+
    ---------------
    -- Add_Class --
    ---------------
@@ -104,13 +113,13 @@ package body Erroutc is
       N1, N2 : Error_Msg_Id;
 
       procedure Delete_Msg (Delete, Keep : Error_Msg_Id);
-      --  Called to delete message Delete, keeping message Keep. Marks
-      --  all messages of Delete with deleted flag set to True, and also
-      --  makes sure that for the error messages that are retained the
-      --  preferred message is the one retained (we prefer the shorter
-      --  one in the case where one has an Instance tag). Note that we
-      --  always know that Keep has at least as many continuations as
-      --  Delete (since we always delete the shorter sequence).
+      --  Called to delete message Delete, keeping message Keep. Marks all
+      --  messages of Delete with deleted flag set to True, and also makes sure
+      --  that for the error messages that are retained the preferred message
+      --  is the one retained (we prefer the shorter one in the case where one
+      --  has an Instance tag). Note that we always know that Keep has at least
+      --  as many continuations as Delete (since we always delete the shorter
+      --  sequence).
 
       ----------------
       -- Delete_Msg --
@@ -219,7 +228,8 @@ package body Erroutc is
    begin
       return Total_Errors_Detected /= 0
         or else (Warnings_Detected /= 0
-                  and then Warning_Mode = Treat_As_Error);
+                  and then Warning_Mode = Treat_As_Error)
+        or else Warnings_Treated_As_Errors /= 0;
    end Compilation_Errors;
 
    ------------------
@@ -289,6 +299,89 @@ package body Erroutc is
       return Cur_Msg;
    end Get_Msg_Id;
 
+   ---------------------
+   -- Get_Warning_Tag --
+   ---------------------
+
+   function Get_Warning_Tag (Id : Error_Msg_Id) return String is
+      Warn     : constant Boolean    := Errors.Table (Id).Warn;
+      Warn_Chr : constant Character  := Errors.Table (Id).Warn_Chr;
+   begin
+      if Warn and then Warn_Chr /= ' ' then
+         if Warn_Chr = '?' then
+            return " [enabled by default]";
+         elsif Warn_Chr in 'a' .. 'z' then
+            return " [-gnatw" & Warn_Chr & ']';
+         else pragma Assert (Warn_Chr in 'A' .. 'Z');
+            return " [-gnatw." & Fold_Lower (Warn_Chr) & ']';
+         end if;
+      else
+         return "";
+      end if;
+   end Get_Warning_Tag;
+
+   -------------
+   -- Matches --
+   -------------
+
+   function Matches (S : String; P : String) return Boolean is
+      Slast : constant Natural := S'Last;
+      PLast : constant Natural := P'Last;
+
+      SPtr : Natural := S'First;
+      PPtr : Natural := P'First;
+
+   begin
+      --  Loop advancing through characters of string and pattern
+
+      SPtr := S'First;
+      PPtr := P'First;
+      loop
+         --  Return True if pattern is a single asterisk
+
+         if PPtr = PLast and then P (PPtr) = '*' then
+            return True;
+
+            --  Return True if both pattern and string exhausted
+
+         elsif PPtr > PLast and then SPtr > Slast then
+            return True;
+
+            --  Return False, if one exhausted and not the other
+
+         elsif PPtr > PLast or else SPtr > Slast then
+            return False;
+
+            --  Case where pattern starts with asterisk
+
+         elsif P (PPtr) = '*' then
+
+            --  Try all possible starting positions in S for match with the
+            --  remaining characters of the pattern. This is the recursive
+            --  call that implements the scanner backup.
+
+            for J in SPtr .. Slast loop
+               if Matches (S (J .. Slast), P (PPtr + 1 .. PLast)) then
+                  return True;
+               end if;
+            end loop;
+
+            return False;
+
+            --  Dealt with end of string and *, advance if we have a match
+
+         elsif Fold_Lower (S (SPtr)) = Fold_Lower (P (PPtr)) then
+            SPtr := SPtr + 1;
+            PPtr := PPtr + 1;
+
+            --  If first characters do not match, that's decisive
+
+         else
+            return False;
+         end if;
+      end loop;
+   end Matches;
+
    -----------------------
    -- Output_Error_Msgs --
    -----------------------
@@ -455,32 +548,12 @@ package body Erroutc is
       Length : Nat;
       --  Maximum total length of lines
 
-      Text     : constant String_Ptr := Errors.Table (E).Text;
-      Warn     : constant Boolean    := Errors.Table (E).Warn;
-      Warn_Chr : constant Character  := Errors.Table (E).Warn_Chr;
-      Warn_Tag : String_Ptr;
-      Ptr      : Natural;
-      Split    : Natural;
-      Start    : Natural;
+      Text  : constant String_Ptr := Errors.Table (E).Text;
+      Ptr   : Natural;
+      Split : Natural;
+      Start : Natural;
 
    begin
-      --  Add warning doc tag if needed
-
-      if Warn and then Warn_Chr /= ' ' then
-         if Warn_Chr = '?' then
-            Warn_Tag := new String'(" [enabled by default]");
-
-         elsif Warn_Chr in 'a' .. 'z' then
-            Warn_Tag := new String'(" [-gnatw" & Warn_Chr & ']');
-
-         else pragma Assert (Warn_Chr in 'A' .. 'Z');
-            Warn_Tag := new String'(" [-gnatw." & Fold_Lower (Warn_Chr) & ']');
-         end if;
-
-      else
-         Warn_Tag := new String'("");
-      end if;
-
       --  Set error message line length
 
       if Error_Msg_Line_Length = 0 then
@@ -492,7 +565,7 @@ package body Erroutc is
       Max := Integer (Length - Column + 1);
 
       declare
-         Txt : constant String  := Text.all & Warn_Tag.all;
+         Txt : constant String  := Text.all & Get_Warning_Tag (E);
          Len : constant Natural := Txt'Length;
 
       begin
@@ -502,8 +575,20 @@ package body Erroutc is
             if Len < 6
               or else Txt (Txt'First .. Txt'First + 5) /= "info: "
             then
-               Write_Str ("warning: ");
-               Max := Max - 9;
+               --  One more check, if warning is to be treated as error, then
+               --  here is where we deal with that.
+
+               if Errors.Table (E).Warn_Err then
+                  Write_Str ("warning(error): ");
+                  Warnings_Treated_As_Errors := Warnings_Treated_As_Errors + 1;
+                  Max := Max - 16;
+
+               --  Normal case
+
+               else
+                  Write_Str ("warning: ");
+                  Max := Max - 9;
+               end if;
             end if;
 
             --  No prefix needed for style message, "(style)" is there already
@@ -1358,75 +1443,6 @@ package body Erroutc is
      (Loc : Source_Ptr;
       Msg : String_Ptr) return String_Id
    is
-      function Matches (S : String; P : String) return Boolean;
-      --  Returns true if the String S patches the pattern P, which can contain
-      --  wild card chars (*). The entire pattern must match the entire string.
-      --  Case is ignored in the comparison (so X matches x).
-
-      -------------
-      -- Matches --
-      -------------
-
-      function Matches (S : String; P : String) return Boolean is
-         Slast : constant Natural := S'Last;
-         PLast : constant Natural := P'Last;
-
-         SPtr : Natural := S'First;
-         PPtr : Natural := P'First;
-
-      begin
-         --  Loop advancing through characters of string and pattern
-
-         SPtr := S'First;
-         PPtr := P'First;
-         loop
-            --  Return True if pattern is a single asterisk
-
-            if PPtr = PLast and then P (PPtr) = '*' then
-               return True;
-
-            --  Return True if both pattern and string exhausted
-
-            elsif PPtr > PLast and then SPtr > Slast then
-               return True;
-
-            --  Return False, if one exhausted and not the other
-
-            elsif PPtr > PLast or else SPtr > Slast then
-               return False;
-
-            --  Case where pattern starts with asterisk
-
-            elsif P (PPtr) = '*' then
-
-               --  Try all possible starting positions in S for match with
-               --  the remaining characters of the pattern. This is the
-               --  recursive call that implements the scanner backup.
-
-               for J in SPtr .. Slast loop
-                  if Matches (S (J .. Slast), P (PPtr + 1 .. PLast)) then
-                     return True;
-                  end if;
-               end loop;
-
-               return False;
-
-            --  Dealt with end of string and *, advance if we have a match
-
-            elsif Fold_Lower (S (SPtr)) = Fold_Lower (P (PPtr)) then
-               SPtr := SPtr + 1;
-               PPtr := PPtr + 1;
-
-            --  If first characters do not match, that's decisive
-
-            else
-               return False;
-            end if;
-         end loop;
-      end Matches;
-
-   --  Start of processing for Warning_Specifically_Suppressed
-
    begin
       --  Loop through specific warning suppression entries
 
@@ -1452,6 +1468,21 @@ package body Erroutc is
       return No_String;
    end Warning_Specifically_Suppressed;
 
+   ------------------------------
+   -- Warning_Treated_As_Error --
+   ------------------------------
+
+   function Warning_Treated_As_Error (Msg : String) return Boolean is
+   begin
+      for J in 1 .. Warnings_As_Errors_Count loop
+         if Matches (Msg, Warnings_As_Errors (J).all) then
+            return True;
+         end if;
+      end loop;
+
+      return False;
+   end Warning_Treated_As_Error;
+
    -------------------------
    -- Warnings_Suppressed --
    -------------------------
diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 75bc208..fa4db90 100644
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -195,6 +195,10 @@ package Erroutc is
       Warn : Boolean;
       --  True if warning message (i.e. insertion character ? appeared)
 
+      Warn_Err : Boolean;
+      --  True if this is a warning message which is to be treated as an error
+      --  as a result of a match with a Warning_As_Error pragma.
+
       Warn_Chr : Character;
       --  Warning character, valid only if Warn is True
       --    ' '      -- ? appeared on its own in message
@@ -375,6 +379,10 @@ package Erroutc is
    --  redundant. If so, the message to be deleted and all its continuations
    --  are marked with the Deleted flag set to True.
 
+   function Get_Warning_Tag (Id : Error_Msg_Id) return String;
+   --  Given an error message ID, return tag showing warning message class, or
+   --  the null string if this option is not enabled or this is not a warning.
+
    procedure Output_Error_Msgs (E : in out Error_Msg_Id);
    --  Output source line, error flag, and text of stored error message and all
    --  subsequent messages for the same line and unit. On return E is set to be
@@ -553,6 +561,11 @@ package Erroutc is
    --  the corresponding warning string is returned (or the null string if no
    --  Warning argument was present in the pragma).
 
+   function Warning_Treated_As_Error (Msg : String) return Boolean;
+   --  Returns True if the warning message Msg matches any of the strings
+   --  given by Warning_As_Error pragmas, as stored in the Warnings_As_Errors
+   --  table by Set_Warning_As_Error.
+
    type Error_Msg_Proc is
      access procedure (Msg : String; Flag_Location : Source_Ptr);
    procedure Validate_Specific_Warnings (Eproc : Error_Msg_Proc);
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index a3f1217..99711e4 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -275,6 +275,7 @@ Implementation Defined Pragmas
 * Pragma Use_VADS_Size::
 * Pragma Validity_Checks::
 * Pragma Volatile::
+* Pragma Warning_As_Error::
 * Pragma Warnings::
 * Pragma Weak_External::
 * Pragma Wide_Character_Encoding::
@@ -1109,6 +1110,7 @@ consideration, the use of these pragmas should be minimized.
 * Pragma Use_VADS_Size::
 * Pragma Validity_Checks::
 * Pragma Volatile::
+* Pragma Warning_As_Error::
 * Pragma Warnings::
 * Pragma Weak_External::
 * Pragma Wide_Character_Encoding::
@@ -7557,6 +7559,80 @@ in some Ada 83 compilers, including DEC Ada 83.  The Ada 95 / Ada 2005
 implementation of pragma Volatile is upwards compatible with the
 implementation in DEC Ada 83.
 
+@node Pragma Warning_As_Error
+@unnumberedsec Pragma Warning_As_Error
+@findex Warning_As_Error
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Warning_As_Error (static_string_EXPRESSION);
+@end smallexample
+
+@noindent
+This configuration pragma allows the programmer to specify a set
+of warnings that will be treated as errors. Any warning which
+matches the pattern given by the pragma argument will be treated
+as an error. This gives much more precise control that -gnatwe
+which treats all warnings as errors.
+
+The pattern may contain asterisks, which match zero or more characters in
+the message. For example, you can use
+@code{pragma Warnings (Off, "*bits of*unused")} to suppress the warning
+message @code{warning: 960 bits of "a" unused}. No other regular
+expression notations are permitted. All characters other than asterisk in
+these three specific cases are treated as literal characters in the match.
+The match is case insensitive, for example XYZ matches xyz.
+
+Another possibility for the static_string_EXPRESSION which works if
+error tags are enabled (@option{-gnatw.e}) is to use the tag string
+preceded by a space,
+as shown in the example below.
+
+The pragma can appear either in a global configuration pragma file
+(e.g. @file{gnat.adc}), or at the start of a file. Given a global
+configuration pragma file containing:
+
+@smallexample @c ada
+pragma Warning_As_Error (" [-gnatwj]");
+@end smallexample
+
+@noindent
+which will treat all obsolescent feature warnings as errors, the
+following program compiles as shown (compile options here are
+@option{-gnatwa.e -gnatld7 -gnatj60}).
+
+@smallexample @c ada
+     1. pragma Warning_As_Error ("*never assigned*");
+     2. function Warnerr return String is
+     3.    X : Integer;
+           |
+        >>> warning(error): variable "X" is never read and
+            never assigned [-gnatwv]
+
+     4.    Y : Integer;
+           |
+        >>> warning: variable "Y" is assigned but never
+            read [-gnatwu]
+
+     5.
+     6. begin
+     7.    Y := 0;
+     8.    return %ABC%;
+                  |
+        >>> warning(error): use of "%" is an obsolescent
+            feature (RM J.2(4)), use """ instead [-gnatwj]
+
+     9. end;
+
+ 9 lines: No errors, 3 warnings (2 treated as errors)
+@end smallexample
+
+@noindent
+Note that this pragma does not affect the set of warnings issued in
+any way, it merely changes the effect of a matching warning if one
+is produced as a result of other warnings options.
+
 @node Pragma Warnings
 @unnumberedsec Pragma Warnings
 @findex Warnings
@@ -7609,12 +7685,14 @@ full details see @ref{Warning Message Control,,, gnat_ugn, @value{EDITION}
 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
-of the compiler. The `GCC' back end can provide additional warnings and they
-are controlled by the `-W' switch.
-The form with a single static_string_EXPRESSION argument also works for the
-latters, but the string must be a single full `-W' switch in this case.
-The above reference lists a few examples of these additional warnings.
+The warnings controlled by the @option{-gnatw} switch are generated by the
+front end of the compiler. The GCC back end can provide additional warnings
+and they are controlled by the @option{-W} switch. Such warnings can be
+identified by the appearance of a string of the form @code{[-Wxxx]} in the
+message which designates the @option{-Wxxx} switch that controls the message.
+The form with a single static_string_EXPRESSION argument also works for these
+warnings, but the string must be a single full @option{-Wxxx} switch in this
+case. The above reference lists a few examples of these additional warnings.
 
 @noindent
 The specified warnings will be in effect until the end of the program
@@ -7638,12 +7716,10 @@ these three specific cases are treated as literal characters in the match.
 The match is case insensitive, for example XYZ matches xyz.
 
 The above use of patterns to match the message applies only to warning
-messages generated by the front end. This form of the pragma with a
-string argument can also be used to control back end warnings controlled
-by a "-Wxxx" switch. Such warnings can be identified by the appearance
-of a string of the form "[-Wxxx]" in the message which identifies the
-"-W" switch that controls the message. By using the text of the
-"-W" switch in the pragma, such back end warnings can be turned on and off.
+messages generated by the front end. This form of the pragma with a string
+argument can also be used to control warnings provided by the back end and
+mentioned above. By using a single full @option{-Wxxx} switch in the pragma,
+such warnings can be turned on and off.
 
 There are two ways to use the pragma in this form. The OFF form can be used as a
 configuration pragma. The effect is to suppress all warnings (if any)
diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads
index cbca304..1b6898d 100644
--- a/gcc/ada/lib.ads
+++ b/gcc/ada/lib.ads
@@ -308,7 +308,7 @@ package Lib is
    --      from running (i.e. fatal error during parsing stops semantics,
    --      fatal error during semantics stops code generation). Note that
    --      currently, errors of any kind cause Fatal_Error to be set, but
-   --      eventually perhaps only errors labeled as Fatal_Errors should be
+   --      eventually perhaps only errors labeled as fatal errors should be
    --      this severe if we decide to try Sem on sources with minor errors.
 
    --    Generate_Code
diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb
index 30623ea..0ff90a1 100644
--- a/gcc/ada/opt.adb
+++ b/gcc/ada/opt.adb
@@ -66,6 +66,7 @@ package body Opt is
       SPARK_Mode_Config                     := SPARK_Mode;
       SPARK_Mode_Pragma_Config              := SPARK_Mode_Pragma;
       Use_VADS_Size_Config                  := Use_VADS_Size;
+      Warnings_As_Errors_Count_Config       := Warnings_As_Errors_Count;
 
       --  Reset the indication that Optimize_Alignment was set locally, since
       --  if we had a pragma in the config file, it would set this flag True,
@@ -103,6 +104,7 @@ package body Opt is
       SPARK_Mode                     := Save.SPARK_Mode;
       SPARK_Mode_Pragma              := Save.SPARK_Mode_Pragma;
       Use_VADS_Size                  := Save.Use_VADS_Size;
+      Warnings_As_Errors_Count       := Save.Warnings_As_Errors_Count;
 
       --  Update consistently the value of Init_Or_Norm_Scalars. The value of
       --  Normalize_Scalars is not saved/restored because after set to True its
@@ -141,6 +143,7 @@ package body Opt is
       Save.SPARK_Mode                     := SPARK_Mode;
       Save.SPARK_Mode_Pragma              := SPARK_Mode_Pragma;
       Save.Use_VADS_Size                  := Use_VADS_Size;
+      Save.Warnings_As_Errors_Count       := Warnings_As_Errors_Count;
    end Save_Opt_Config_Switches;
 
    -----------------------------
@@ -171,6 +174,9 @@ package body Opt is
          Use_VADS_Size               := False;
          Optimize_Alignment_Local    := True;
 
+         --  Note: we do not need to worry about Warnings_As_Errors_Count since
+         --  we do not expect to get any warnings from compiling such a unit.
+
          --  For an internal unit, assertions/debug pragmas are off unless this
          --  is the main unit and they were explicitly enabled. We also make
          --  sure we do not assume that values are necessarily valid and that
@@ -212,6 +218,7 @@ package body Opt is
          SPARK_Mode                  := SPARK_Mode_Config;
          SPARK_Mode_Pragma           := SPARK_Mode_Pragma_Config;
          Use_VADS_Size               := Use_VADS_Size_Config;
+         Warnings_As_Errors_Count    := Warnings_As_Errors_Count_Config;
 
          --  Update consistently the value of Init_Or_Norm_Scalars. The value
          --  of Normalize_Scalars is not saved/restored because once set to
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 2f8174a..90bf403 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1761,6 +1761,10 @@ package Opt is
    --  unless we are in GNATprove_Mode, which requires pragma Warnings to
    --  be stored for the formal verification backend.
 
+   Warnings_As_Errors_Count : Natural;
+   --  GNAT
+   --  Number of entries stored in Warnings_As_Errors table
+
    Wide_Character_Encoding_Method : WC_Encoding_Method := WCEM_Brackets;
    --  GNAT, GNATBIND
    --  Method used for encoding wide characters in the source program. See
@@ -1952,6 +1956,10 @@ package Opt is
    --  is ignored for internal and predefined units (which are always compiled
    --  with the standard Size semantics).
 
+   Warnings_As_Errors_Count_Config : Natural;
+   --  GNAT
+   --  Count of pattern strings stored from Warning_As_Error pragmas
+
    type Config_Switches_Type is private;
    --  Type used to save values of the switches set from Config values
 
@@ -2055,6 +2063,26 @@ package Opt is
    --  that this is completely separate from the SPARK restriction defined in
    --  GNAT to detect violations of a subset of SPARK 2005 rules.
 
+   ---------------------------
+   -- Error/Warning Control --
+   ---------------------------
+
+   --  The following array would more reasonably be located in Err_Vars or
+   --  Errour, but but we put them here to deal with licensing issues (we need
+   --  this to have the GPL exception licensing, since these variables and
+   --  subprograms are accessed from units with this licensing).
+
+   Warnings_As_Errors : array (1 .. 10_000) of String_Ptr;
+   --  Table for recording Warning_As_Error pragmas as they are processed.
+   --  It would be nicer to use Table, but there are circular elaboration
+   --  problems if we try to do this, and an attempt to find some other
+   --  appropriately licensed unit to declare this as a Table failed with
+   --  various elaboration circularities. Memory is getting cheap these days!
+
+   --------------------------
+   -- Private Declarations --
+   --------------------------
+
 private
 
    --  The following type is used to save and restore settings of switches in
@@ -2089,6 +2117,7 @@ private
       SPARK_Mode                     : SPARK_Mode_Type;
       SPARK_Mode_Pragma              : Node_Id;
       Use_VADS_Size                  : Boolean;
+      Warnings_As_Errors_Count       : Natural;
    end record;
 
    --  The following declarations are for GCC version dependent flags. We do
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index 14560ea..32b8fb7 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1336,6 +1336,7 @@ begin
            Pragma_Use_VADS_Size                  |
            Pragma_Volatile                       |
            Pragma_Volatile_Components            |
+           Pragma_Warning_As_Error               |
            Pragma_Weak_External                  |
            Pragma_Validity_Checks                =>
          null;
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index ad7d880..5020b59 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -5007,6 +5007,16 @@ package body Sem_Ch3 is
       while Present (Index) loop
          Analyze (Index);
 
+         --  Test for odd case of trying to index a type by the type itself
+
+         if Is_Entity_Name (Index) and then Entity (Index) = T then
+            Error_Msg_N ("type& cannot be indexed by itself", Index);
+            Set_Entity (Index, Standard_Boolean);
+            Set_Etype (Index, Standard_Boolean);
+         end if;
+
+         --  Check SPARK restriction requiring a subtype mark
+
          if not Nkind_In (Index, N_Identifier, N_Expanded_Name) then
             Check_SPARK_Restriction ("subtype mark required", Index);
          end if;
diff --git a/gcc/ada/sem_mech.adb b/gcc/ada/sem_mech.adb
index f71a477b..44a3da9 100644
--- a/gcc/ada/sem_mech.adb
+++ b/gcc/ada/sem_mech.adb
@@ -462,8 +462,8 @@ package body Sem_Mech is
 
                when Convention_Fortran =>
 
-                  --  In OpenVMS, pass a character of array of character
-                  --  value using Descriptor(S).
+                  --  In OpenVMS, pass character and string types using
+                  --  Short_Descriptor(S)
 
                   if OpenVMS_On_Target
                     and then (Root_Type (Typ) = Standard_Character
@@ -473,7 +473,7 @@ package body Sem_Mech is
                                      Root_Type (Component_Type (Typ)) =
                                                      Standard_Character))
                   then
-                     Set_Mechanism (Formal, By_Descriptor_S);
+                     Set_Mechanism (Formal, By_Short_Descriptor_S);
 
                   --  Access types are passed by default (presumably this
                   --  will mean they are passed by copy)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ad6167b..b359004 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -21269,6 +21269,31 @@ package body Sem_Prag is
 
          --  Volatile is handled by the same circuit as Atomic_Components
 
+         ----------------------
+         -- Warning_As_Error --
+         ----------------------
+
+         when Pragma_Warning_As_Error =>
+            GNAT_Pragma;
+            Check_Arg_Count (1);
+            Check_No_Identifiers;
+            Check_Valid_Configuration_Pragma;
+
+            if not Is_Static_String_Expression (Arg1) then
+               Error_Pragma_Arg
+                 ("argument of pragma% must be static string expression",
+                  Arg1);
+
+            --  OK static string expression
+
+            else
+               String_To_Name_Buffer
+                 (Strval (Expr_Value_S (Get_Pragma_Arg (Arg1))));
+               Warnings_As_Errors_Count := Warnings_As_Errors_Count + 1;
+               Warnings_As_Errors (Warnings_As_Errors_Count) :=
+                 new String'(Name_Buffer (1 .. Name_Len));
+            end if;
+
          --------------
          -- Warnings --
          --------------
@@ -21481,14 +21506,14 @@ package body Sem_Prag is
                            end loop;
                         end if;
 
-                     --  Error if not entity or static string literal case
+                     --  Error if not entity or static string expression case
 
                      elsif not Is_Static_String_Expression (Arg2) then
                         Error_Pragma_Arg
                           ("second argument of pragma% must be entity name "
                            & "or static string expression", Arg2);
 
-                     --  String literal case
+                     --  Static string expression case
 
                      else
                         String_To_Name_Buffer
@@ -25885,6 +25910,7 @@ package body Sem_Prag is
       Pragma_Validity_Checks                => -1,
       Pragma_Volatile                       =>  0,
       Pragma_Volatile_Components            =>  0,
+      Pragma_Warning_As_Error               => -1,
       Pragma_Warnings                       => -1,
       Pragma_Weak_External                  => -1,
       Pragma_Wide_Character_Encoding        =>  0,
diff --git a/gcc/ada/sigtramp-ppcvxw.c b/gcc/ada/sigtramp-ppcvxw.c
index 1a9ba6a..0432b08 100644
--- a/gcc/ada/sigtramp-ppcvxw.c
+++ b/gcc/ada/sigtramp-ppcvxw.c
@@ -186,6 +186,7 @@ CR(".cfi_def_cfa " S(CFA_REG) ", 0")
 
 #define CFI_COMMON_REGS \
 CR("# CFI for common registers\n") \
+TCR(COMMON_CFI(GR(0)))  \
 TCR(COMMON_CFI(GR(1)))  \
 TCR(COMMON_CFI(GR(2)))  \
 TCR(COMMON_CFI(GR(3)))  \
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 76300a9..c8831b3 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -445,6 +445,7 @@ package Snames is
    Name_Unsuppress                     : constant Name_Id := N + $; -- Ada 05
    Name_Use_VADS_Size                  : constant Name_Id := N + $; -- GNAT
    Name_Validity_Checks                : constant Name_Id := N + $; -- GNAT
+   Name_Warning_As_Error               : constant Name_Id := N + $; -- GNAT
    Name_Warnings                       : constant Name_Id := N + $; -- GNAT
    Name_Wide_Character_Encoding        : constant Name_Id := N + $; -- GNAT
    Last_Configuration_Pragma_Name      : constant Name_Id := N + $;
@@ -1790,6 +1791,7 @@ package Snames is
       Pragma_Unsuppress,
       Pragma_Use_VADS_Size,
       Pragma_Validity_Checks,
+      Pragma_Warning_As_Error,
       Pragma_Warnings,
       Pragma_Wide_Character_Encoding,