exp_intr.adb (Write_Entity_Name): Moved to outer level

2014-10-10  Robert Dewar  <dewar@adacore.com>

	* exp_intr.adb (Write_Entity_Name): Moved to outer level
	(Write_Entity_Name): Properly handle operator names
	(Expand_Source_Info): New procedure.
	* exp_intr.ads (Add_Source_Info): New procedure.

2014-10-10  Robert Dewar  <dewar@adacore.com>

	* butil.ads: Minor reformatting.
	* sem_ch5.adb: Code clean up.

2014-10-10  Robert Dewar  <dewar@adacore.com>

	* exp_ch11.adb (Expand_N_Raise_Statement): Handle
	Prefix_Exception_Messages.
	* opt.adb: Handle new flags Prefix_Exception_Message[_Config].
	* opt.ads: New flags Prefix_Exception_Message[_Config].
	* par-prag.adb: New dummy entry for pragma Prefix_Exception_Messages.
	* snames.ads-tmpl: Add entries for new pragma Prefix_Exception_Messages.
	* sem_prag.adb: Implement new pragma Prefix_Exception_Messages
	* gnat_rm.texi: Document pragma Prefix_Exception_Messages.

From-SVN: r216088

12 files changed, 284 insertions, 64 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index d410c97..a621e39 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,26 @@
+2014-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* exp_intr.adb (Write_Entity_Name): Moved to outer level
+	(Write_Entity_Name): Properly handle operator names
+	(Expand_Source_Info): New procedure.
+	* exp_intr.ads (Add_Source_Info): New procedure.
+
+2014-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* butil.ads: Minor reformatting.
+	* sem_ch5.adb: Code clean up.
+
+2014-10-10  Robert Dewar  <dewar@adacore.com>
+
+	* exp_ch11.adb (Expand_N_Raise_Statement): Handle
+	Prefix_Exception_Messages.
+	* opt.adb: Handle new flags Prefix_Exception_Message[_Config].
+	* opt.ads: New flags Prefix_Exception_Message[_Config].
+	* par-prag.adb: New dummy entry for pragma Prefix_Exception_Messages.
+	* snames.ads-tmpl: Add entries for new pragma Prefix_Exception_Messages.
+	* sem_prag.adb: Implement new pragma Prefix_Exception_Messages
+	* gnat_rm.texi: Document pragma Prefix_Exception_Messages.
+
 2014-10-10  Gary Dismukes  <dismukes@adacore.com>
 
 	* sinfo.ads, gnat_ugn.texi, a-except.adb, a-except-2005.adb,
diff --git a/gcc/ada/butil.ads b/gcc/ada/butil.ads
index 72fffc0..ddfa251 100644
--- a/gcc/ada/butil.ads
+++ b/gcc/ada/butil.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -38,7 +38,7 @@ package Butil is
    function Is_Internal_Unit return Boolean;
    --  Given a unit name stored in Name_Buffer with length in Name_Len,
    --  returns True if this is the name of an internal unit or a child of
-   --  an internal. Similar in usage to Is_Predefined_Unit.
+   --  an internal unit. Similar in usage to Is_Predefined_Unit.
 
    --  Note: the following functions duplicate functionality in Uname, but
    --  we want to avoid bringing Uname into the binder since it generates
diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb
index aafa2b4..1d437af 100644
--- a/gcc/ada/exp_ch11.adb
+++ b/gcc/ada/exp_ch11.adb
@@ -29,6 +29,7 @@ with Einfo;    use Einfo;
 with Elists;   use Elists;
 with Errout;   use Errout;
 with Exp_Ch7;  use Exp_Ch7;
+with Exp_Intr; use Exp_Intr;
 with Exp_Util; use Exp_Util;
 with Namet;    use Namet;
 with Nlists;   use Nlists;
@@ -1565,6 +1566,22 @@ package body Exp_Ch11 is
 
       if Present (Expression (N)) then
 
+         --  Adjust message to deal with Prefix_Exception_Messages. We only
+         --  add the prefix to string literals, if the message is being
+         --  constructed, we assume it already deals with uniqueness.
+
+         if Prefix_Exception_Messages
+           and then Nkind (Expression (N)) = N_String_Literal
+         then
+            Name_Len := 0;
+            Add_Source_Info (Loc, Name_Enclosing_Entity);
+            Add_Str_To_Name_Buffer (": ");
+            Add_String_To_Name_Buffer (Strval (Expression (N)));
+            Rewrite (Expression (N),
+              Make_String_Literal (Loc, Name_Buffer (1 .. Name_Len)));
+            Analyze_And_Resolve (Expression (N), Standard_String);
+         end if;
+
          --  Avoid passing exception-name'identity in runtimes in which this
          --  argument is not used. This avoids generating undefined references
          --  to these exceptions when compiling with no optimization
diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index 465c8b2..aa73839 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -36,7 +36,6 @@ with Exp_Code; use Exp_Code;
 with Exp_Fixd; use Exp_Fixd;
 with Exp_Util; use Exp_Util;
 with Freeze;   use Freeze;
-with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Nlists;   use Nlists;
 with Opt;      use Opt;
@@ -116,6 +115,96 @@ package body Exp_Intr is
    --    Name_Compilation_Date      - expand string with compilation date
    --    Name_Compilation_Time      - expand string with compilation time
 
+   procedure Write_Entity_Name (E : Entity_Id);
+   --  Recursive procedure to construct string for qualified name of enclosing
+   --  program unit. The qualification stops at an enclosing scope has no
+   --  source name (block or loop). If entity is a subprogram instance, skip
+   --  enclosing wrapper package. The name is appended to the current contents
+   --  of Name_Buffer, incrementing Name_Len.
+
+   ---------------------
+   -- Add_Source_Info --
+   ---------------------
+
+   procedure Add_Source_Info (Loc : Source_Ptr; Nam : Name_Id) is
+      Ent : Entity_Id;
+
+      Save_NB : constant String  := Name_Buffer (1 .. Name_Len);
+      Save_NL : constant Natural := Name_Len;
+      --  Save current Name_Buffer contents
+
+   begin
+      Name_Len := 0;
+
+      --  Line
+
+      case Nam is
+
+         when Name_Line =>
+            Add_Nat_To_Name_Buffer (Nat (Get_Logical_Line_Number (Loc)));
+
+         when Name_File =>
+            Get_Decoded_Name_String
+              (Reference_Name (Get_Source_File_Index (Loc)));
+
+         when Name_Source_Location =>
+            Build_Location_String (Loc);
+
+         when Name_Enclosing_Entity =>
+
+            --  Skip enclosing blocks to reach enclosing unit
+
+            Ent := Current_Scope;
+            while Present (Ent) loop
+               exit when Ekind (Ent) /= E_Block
+                 and then Ekind (Ent) /= E_Loop;
+               Ent := Scope (Ent);
+            end loop;
+
+            --  Ent now points to the relevant defining entity
+
+            Write_Entity_Name (Ent);
+
+         when Name_Compilation_Date =>
+            declare
+               subtype S13 is String (1 .. 3);
+               Months : constant array (1 .. 12) of S13 :=
+                          ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
+                           "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");
+
+               M1 : constant Character := Opt.Compilation_Time (6);
+               M2 : constant Character := Opt.Compilation_Time (7);
+
+               MM : constant Natural range 1 .. 12 :=
+                      (Character'Pos (M1) - Character'Pos ('0')) * 10 +
+                 (Character'Pos (M2) - Character'Pos ('0'));
+
+            begin
+               --  Reformat ISO date into MMM DD YYYY (__DATE__) format
+
+               Name_Buffer (1 .. 3)  := Months (MM);
+               Name_Buffer (4)       := ' ';
+               Name_Buffer (5 .. 6)  := Opt.Compilation_Time (9 .. 10);
+               Name_Buffer (7)       := ' ';
+               Name_Buffer (8 .. 11) := Opt.Compilation_Time (1 .. 4);
+               Name_Len := 11;
+            end;
+
+         when Name_Compilation_Time =>
+            Name_Buffer (1 .. 8) := Opt.Compilation_Time (12 .. 19);
+            Name_Len := 8;
+
+         when others =>
+            raise Program_Error;
+      end case;
+
+      --  Prepend original Name_Buffer contents
+
+      Name_Buffer (Save_NL + 1 .. Save_NL + Name_Len) :=
+        Name_Buffer (1 .. Name_Len);
+      Name_Buffer (1 .. Save_NL) := Save_NB;
+   end Add_Source_Info;
+
    ---------------------------------
    -- Expand_Binary_Operator_Call --
    ---------------------------------
@@ -718,61 +807,6 @@ package body Exp_Intr is
       Loc : constant Source_Ptr := Sloc (N);
       Ent : Entity_Id;
 
-      procedure Write_Entity_Name (E : Entity_Id);
-      --  Recursive procedure to construct string for qualified name of
-      --  enclosing program unit. The qualification stops at an enclosing
-      --  scope has no source name (block or loop). If entity is a subprogram
-      --  instance, skip enclosing wrapper package.
-
-      -----------------------
-      -- Write_Entity_Name --
-      -----------------------
-
-      procedure Write_Entity_Name (E : Entity_Id) is
-         SDef : Source_Ptr;
-         TDef : constant Source_Buffer_Ptr :=
-                  Source_Text (Get_Source_File_Index (Sloc (E)));
-
-      begin
-         --  Nothing to do if at outer level
-
-         if Scope (E) = Standard_Standard then
-            null;
-
-         --  If scope comes from source, write its name
-
-         elsif Comes_From_Source (Scope (E)) then
-            Write_Entity_Name (Scope (E));
-            Add_Char_To_Name_Buffer ('.');
-
-         --  If in wrapper package skip past it
-
-         elsif Is_Wrapper_Package (Scope (E)) then
-            Write_Entity_Name (Scope (Scope (E)));
-            Add_Char_To_Name_Buffer ('.');
-
-         --  Otherwise nothing to output (happens in unnamed block statements)
-
-         else
-            null;
-         end if;
-
-         --  Loop to output the name
-
-         --  This is not right wrt wide char encodings ??? ()
-
-         SDef := Sloc (E);
-         while TDef (SDef) in '0' .. '9'
-           or else TDef (SDef) >= 'A'
-           or else TDef (SDef) = ASCII.ESC
-         loop
-            Add_Char_To_Name_Buffer (TDef (SDef));
-            SDef := SDef + 1;
-         end loop;
-      end Write_Entity_Name;
-
-   --  Start of processing for Expand_Source_Info
-
    begin
       --  Integer cases
 
@@ -1362,4 +1396,70 @@ package body Exp_Intr is
       Analyze (N);
    end Expand_To_Pointer;
 
+   -----------------------
+   -- Write_Entity_Name --
+   -----------------------
+
+   procedure Write_Entity_Name (E : Entity_Id) is
+      SDef : Source_Ptr;
+      TDef : constant Source_Buffer_Ptr :=
+               Source_Text (Get_Source_File_Index (Sloc (E)));
+
+   begin
+      --  Nothing to do if at outer level
+
+      if Scope (E) = Standard_Standard then
+         null;
+
+         --  If scope comes from source, write its name
+
+      elsif Comes_From_Source (Scope (E)) then
+         Write_Entity_Name (Scope (E));
+         Add_Char_To_Name_Buffer ('.');
+
+         --  If in wrapper package skip past it
+
+      elsif Is_Wrapper_Package (Scope (E)) then
+         Write_Entity_Name (Scope (Scope (E)));
+         Add_Char_To_Name_Buffer ('.');
+
+         --  Otherwise nothing to output (happens in unnamed block statements)
+
+      else
+         null;
+      end if;
+
+      --  Output the name
+
+      SDef := Sloc (E);
+
+      --  Check for operator name in quotes
+
+      if TDef (SDef) = '"' then
+         Add_Char_To_Name_Buffer ('"');
+
+         --  Loop to output characters of operator name and terminating quote
+
+         loop
+            SDef := SDef + 1;
+            Add_Char_To_Name_Buffer (TDef (SDef));
+            exit when TDef (SDef) = '"';
+         end loop;
+
+      --  Normal case of identifier
+
+      else
+         --  Loop to output the name
+
+         --  This is not right wrt wide char encodings ??? ()
+
+         while TDef (SDef) in '0' .. '9'
+           or else TDef (SDef) >= 'A'
+           or else TDef (SDef) = ASCII.ESC
+         loop
+            Add_Char_To_Name_Buffer (TDef (SDef));
+            SDef := SDef + 1;
+         end loop;
+      end if;
+   end Write_Entity_Name;
 end Exp_Intr;
diff --git a/gcc/ada/exp_intr.ads b/gcc/ada/exp_intr.ads
index 1285f4f..f9be797 100644
--- a/gcc/ada/exp_intr.ads
+++ b/gcc/ada/exp_intr.ads
@@ -25,10 +25,22 @@
 
 --  Processing for expanding intrinsic subprogram calls
 
+with Namet; use Namet;
 with Types; use Types;
 
 package Exp_Intr is
 
+   procedure Add_Source_Info (Loc : Source_Ptr; Nam : Name_Id);
+   --  Append a string to Name_Buffer depending on Nam
+   --    Name_File                  - append name of source file
+   --    Name_Line                  - append line number
+   --    Name_Source_Location       - append source location (file:line)
+   --    Name_Enclosing_Entity      - append name of enclosing entity
+   --    Name_Compilation_Date      - append compilation date
+   --    Name_Compilation_Time      - append compilation time
+   --  The caller must set Name_Buffer and Name_Len before the call. Loc is
+   --  passed to provide location information where it is needed.
+
    procedure Expand_Intrinsic_Call (N : Node_Id; E : Entity_Id);
    --  N is either a function call node, a procedure call statement node, or
    --  an operator where the corresponding subprogram is intrinsic (i.e. was
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 5554f68..b0bed4b 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -227,6 +227,7 @@ Implementation Defined Pragmas
 * Pragma Precondition::
 * Pragma Predicate::
 * Pragma Preelaborable_Initialization::
+* Pragma Prefix_Exception_Messages::
 * Pragma Pre_Class::
 * Pragma Priority_Specific_Dispatching::
 * Pragma Profile::
@@ -1096,6 +1097,7 @@ consideration, the use of these pragmas should be minimized.
 * Pragma Precondition::
 * Pragma Predicate::
 * Pragma Preelaborable_Initialization::
+* Pragma Prefix_Exception_Messages::
 * Pragma Pre_Class::
 * Pragma Priority_Specific_Dispatching::
 * Pragma Profile::
@@ -5692,6 +5694,34 @@ This pragma is standard in Ada 2005, but is available in all earlier
 versions of Ada as an implementation-defined pragma.
 See Ada 2012 Reference Manual for details.
 
+@node Pragma Prefix_Exception_Messages
+@unnumberedsec Pragma Prefix_Exception_Messages
+@cindex Prefix_Exception_Messages
+@cindex exception
+@cindex Exception_Message
+@findex Exceptions
+@noindent
+Syntax:
+
+@smallexample @c ada
+pragma Prefix_Exception_Messages;
+@end smallexample
+
+@noindent
+This is an implementation-defined configuration pragma that affects the
+behavior of raise statements with a message given as a static string
+constant (typically a string literal). In such cases, the string will
+be automatically prefixed by the name of the enclosing entity (giving
+the package and subprogram containing the raise statement). This helps
+to identify where messages are coming from, and this mode is automatic
+for the run-time library.
+
+The pragma has no effect if the message is computed with an expression other
+than a static string constant, since the assumption in this case is that
+the program computes exactly the string it wants. If you still want the
+prefixing in this case, you can always call
+@code{GNAT.Source_Info.Enclosing_Entity} and prepend the string manually.
+
 @node Pragma Pre_Class
 @unnumberedsec Pragma Pre_Class
 @cindex Pre_Class
@@ -6199,7 +6229,7 @@ any other use of implementation pragmas:
 
 @smallexample @c ada
 pragma Restriction_Warnings (No_Implementation_Pragmas);
-pragma Warnings (Off, "violation of*No_Implementation_Pragmas*");
+7 (Off, "violation of*No_Implementation_Pragmas*");
 pragma Ada_95;
 pragma Style_Checks ("2bfhkM160");
 pragma Warnings (On, "violation of*No_Implementation_Pragmas*");
@@ -7825,7 +7855,9 @@ it occurs till the end of the extended scope of the variable (similar to
 the scope of @code{Suppress}). This form cannot be used as a configuration
 pragma.
 
-The form with a single static_string_EXPRESSION argument (and possible
+In the case where the first argument is other than @code{ON} or
+@code{OFF},
+the third 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
diff --git a/gcc/ada/opt.adb b/gcc/ada/opt.adb
index 4144340..9631ff4 100644
--- a/gcc/ada/opt.adb
+++ b/gcc/ada/opt.adb
@@ -63,6 +63,7 @@ package body Opt is
       Optimize_Alignment_Config             := Optimize_Alignment;
       Persistent_BSS_Mode_Config            := Persistent_BSS_Mode;
       Polling_Required_Config               := Polling_Required;
+      Prefix_Exception_Messages_Config      := Prefix_Exception_Messages;
       SPARK_Mode_Config                     := SPARK_Mode;
       SPARK_Mode_Pragma_Config              := SPARK_Mode_Pragma;
       Uneval_Old_Config                     := Uneval_Old;
@@ -102,6 +103,7 @@ package body Opt is
       Optimize_Alignment_Local       := Save.Optimize_Alignment_Local;
       Persistent_BSS_Mode            := Save.Persistent_BSS_Mode;
       Polling_Required               := Save.Polling_Required;
+      Prefix_Exception_Messages      := Save.Prefix_Exception_Messages;
       SPARK_Mode                     := Save.SPARK_Mode;
       SPARK_Mode_Pragma              := Save.SPARK_Mode_Pragma;
       Uneval_Old                     := Save.Uneval_Old;
@@ -142,6 +144,7 @@ package body Opt is
       Save.Optimize_Alignment_Local       := Optimize_Alignment_Local;
       Save.Persistent_BSS_Mode            := Persistent_BSS_Mode;
       Save.Polling_Required               := Polling_Required;
+      Save.Prefix_Exception_Messages      := Prefix_Exception_Messages;
       Save.SPARK_Mode                     := SPARK_Mode;
       Save.SPARK_Mode_Pragma              := SPARK_Mode_Pragma;
       Save.Uneval_Old                     := Uneval_Old;
@@ -174,6 +177,7 @@ package body Opt is
          External_Name_Imp_Casing    := Lowercase;
          Optimize_Alignment          := 'O';
          Persistent_BSS_Mode         := False;
+         Prefix_Exception_Messages   := True;
          Uneval_Old                  := 'E';
          Use_VADS_Size               := False;
          Optimize_Alignment_Local    := True;
@@ -221,6 +225,7 @@ package body Opt is
          Optimize_Alignment          := Optimize_Alignment_Config;
          Optimize_Alignment_Local    := False;
          Persistent_BSS_Mode         := Persistent_BSS_Mode_Config;
+         Prefix_Exception_Messages   := Prefix_Exception_Messages_Config;
          SPARK_Mode                  := SPARK_Mode_Config;
          SPARK_Mode_Pragma           := SPARK_Mode_Pragma_Config;
          Uneval_Old                  := Uneval_Old_Config;
@@ -236,6 +241,8 @@ package body Opt is
          Init_Or_Norm_Scalars := Initialize_Scalars or Normalize_Scalars;
       end if;
 
+      --  Values set for all units
+
       Default_Pool                   := Default_Pool_Config;
       Exception_Locations_Suppressed := Exception_Locations_Suppressed_Config;
       Fast_Math                      := Fast_Math_Config;
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index 2e00d4a..ebf37b6 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1188,6 +1188,10 @@ package Opt is
    --  Set to True if polling for asynchronous abort is enabled by using
    --  the -gnatP option for GNAT.
 
+   Prefix_Exception_Messages : Boolean := False;
+   --  GNAT
+   --  Set True to prefix exception messages with entity-name:
+
    Preprocessing_Data_File : String_Ptr := null;
    --  GNAT
    --  Set by switch -gnatep=. The file name of the preprocessing data file.
@@ -1950,6 +1954,9 @@ package Opt is
    --  flag is used to set the initial value for Polling_Required at the start
    --  of analyzing each unit.
 
+   Prefix_Exception_Messages_Config : Boolean;
+   --  The setting of Prefix_Exception_Messages from configuration pragmas
+
    SPARK_Mode_Config : SPARK_Mode_Type := None;
    --  GNAT
    --  The setting of SPARK_Mode from configuration pragmas
@@ -2197,6 +2204,7 @@ private
       Optimize_Alignment_Local       : Boolean;
       Persistent_BSS_Mode            : Boolean;
       Polling_Required               : Boolean;
+      Prefix_Exception_Messages      : Boolean;
       SPARK_Mode                     : SPARK_Mode_Type;
       SPARK_Mode_Pragma              : Node_Id;
       Uneval_Old                     : Character;
diff --git a/gcc/ada/par-prag.adb b/gcc/ada/par-prag.adb
index b440122..128ff22 100644
--- a/gcc/ada/par-prag.adb
+++ b/gcc/ada/par-prag.adb
@@ -1275,6 +1275,7 @@ begin
            Pragma_Passive                        |
            Pragma_Preelaborable_Initialization   |
            Pragma_Polling                        |
+           Pragma_Prefix_Exception_Messages      |
            Pragma_Persistent_BSS                 |
            Pragma_Post                           |
            Pragma_Postcondition                  |
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 1e731f8..22d11b0 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -2926,7 +2926,12 @@ package body Sem_Ch5 is
          Stat : Node_Id;
 
       begin
-         if Ekind (Current_Scope) /= E_Block then
+
+         --  Check if current scope is a block that is not a transient block.
+
+         if Ekind (Current_Scope) /= E_Block
+           or else No (Block_Node (Current_Scope))
+         then
             return False;
 
          else
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index ec04419..bde78e4 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -17753,6 +17753,18 @@ package body Sem_Prag is
             end if;
          end Preelaborate;
 
+         -------------------------------
+         -- Prefix_Exception_Messages --
+         -------------------------------
+
+         --  pragma Prefix_Exception_Messages;
+
+         when Pragma_Prefix_Exception_Messages =>
+            GNAT_Pragma;
+            Check_Valid_Configuration_Pragma;
+            Check_Arg_Count (0);
+            Prefix_Exception_Messages := True;
+
          --------------
          -- Priority --
          --------------
@@ -24739,7 +24751,7 @@ package body Sem_Prag is
    --  whether appearance of some name in a given pragma is to be considered
    --  as a reference for the purposes of warnings about unreferenced objects.
 
-   --  -1  indicates that references in any argument position are significant
+   --  -1  indicates that appearence in any argument is significant
    --  0   indicates that appearance in any argument is not significant
    --  +n  indicates that appearance as argument n is significant, but all
    --      other arguments are not significant
@@ -24881,14 +24893,15 @@ package body Sem_Prag is
       Pragma_Optimize_Alignment             => -1,
       Pragma_Overflow_Mode                  =>  0,
       Pragma_Overriding_Renamings           =>  0,
-      Pragma_Ordered                        =>  0,
+      Pragma_Ordered                        => -1,
       Pragma_Pack                           =>  0,
       Pragma_Page                           => -1,
       Pragma_Part_Of                        => -1,
       Pragma_Partition_Elaboration_Policy   => -1,
       Pragma_Passive                        => -1,
       Pragma_Persistent_BSS                 =>  0,
-      Pragma_Polling                        => -1,
+      Pragma_Polling                        =>  0,
+      Pragma_Prefix_Exception_Messages      =>  0,
       Pragma_Post                           => -1,
       Pragma_Postcondition                  => -1,
       Pragma_Post_Class                     => -1,
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index c1b62b2..cdc8253 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -415,6 +415,7 @@ package Snames is
    Name_Partition_Elaboration_Policy   : constant Name_Id := N + $; -- Ada 05
    Name_Persistent_BSS                 : constant Name_Id := N + $; -- GNAT
    Name_Polling                        : constant Name_Id := N + $; -- GNAT
+   Name_Prefix_Exception_Messages      : constant Name_Id := N + $; -- GNAT
    Name_Priority_Specific_Dispatching  : constant Name_Id := N + $; -- Ada 05
    Name_Profile                        : constant Name_Id := N + $; -- Ada 05
    Name_Profile_Warnings               : constant Name_Id := N + $; -- GNAT
@@ -1755,6 +1756,7 @@ package Snames is
       Pragma_Partition_Elaboration_Policy,
       Pragma_Persistent_BSS,
       Pragma_Polling,
+      Pragma_Prefix_Exception_Messages,
       Pragma_Priority_Specific_Dispatching,
       Pragma_Profile,
       Pragma_Profile_Warnings,