This implements a new configuration pragma
pragma Prefix_Exception_Messages;
which causes messages set using "raise x with s" to be
prefixed by the expanded name of the enclosing entity if
s is a string literal (if s is more complex, we assume
the program is calculating exactly the message it wants).
So for example, if we have the program:
1. pragma Prefix_Exception_Messages;
2. procedure Prefixem is
3. procedure Inner is
4. begin
5. raise Constraint_Error with "explicit raise";
6. end;
7. begin
8. Inner;
9. end Prefixem;
The output will be:
raised CONSTRAINT_ERROR : Prefixem.Inner: explicit raise
This mode is automatic for run-time library files, so
a typical message from the runtime library which used to
look like:
raised GNAT.CALENDAR.TIME_IO.PICTURE_ERROR :
null picture string
now looks like:
raised GNAT.CALENDAR.TIME_IO.PICTURE_ERROR :
GNAT.Calendar.Time_IO.Image: null picture string
In the case of instantiations of containers, you will get the full
qualified name of the particular instantiation that is involved. For
example, the following program:
1. with Ada.Containers.Ordered_Sets;
2. procedure NoElmt is
3. package Ordered_Integer_Sets is
4. new Ada.Containers.Ordered_Sets (Integer);
5. use Ordered_Integer_Sets;
6. begin
7. if No_Element < No_Element then
8. null;
9. end if;
10. end;
will output
raised CONSTRAINT_ERROR :
NoElmt.Ordered_Integer_Sets."<": Left cursor equals No_Element
This allows disambiguation of messages without reintroducing
line numbers which are problematic for maintaining tests over
different versions and targets.
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-10 Robert Dewar <de...@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.
Index: exp_ch11.adb
===================================================================
--- exp_ch11.adb (revision 216063)
+++ exp_ch11.adb (working copy)
@@ -29,6 +29,7 @@
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 @@
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
Index: gnat_rm.texi
===================================================================
--- gnat_rm.texi (revision 216081)
+++ gnat_rm.texi (working copy)
@@ -227,6 +227,7 @@
* Pragma Precondition::
* Pragma Predicate::
* Pragma Preelaborable_Initialization::
+* Pragma Prefix_Exception_Messages::
* Pragma Pre_Class::
* Pragma Priority_Specific_Dispatching::
* Pragma Profile::
@@ -1096,6 +1097,7 @@
* Pragma Precondition::
* Pragma Predicate::
* Pragma Preelaborable_Initialization::
+* Pragma Prefix_Exception_Messages::
* Pragma Pre_Class::
* Pragma Priority_Specific_Dispatching::
* Pragma Profile::
@@ -5692,6 +5694,34 @@
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 @@
@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 @@
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
Index: opt.adb
===================================================================
--- opt.adb (revision 216063)
+++ opt.adb (working copy)
@@ -63,6 +63,7 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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;
Index: opt.ads
===================================================================
--- opt.ads (revision 216063)
+++ opt.ads (working copy)
@@ -1188,6 +1188,10 @@
-- 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 @@
-- 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 @@
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;
Index: par-prag.adb
===================================================================
--- par-prag.adb (revision 216063)
+++ par-prag.adb (working copy)
@@ -1275,6 +1275,7 @@
Pragma_Passive |
Pragma_Preelaborable_Initialization |
Pragma_Polling |
+ Pragma_Prefix_Exception_Messages |
Pragma_Persistent_BSS |
Pragma_Post |
Pragma_Postcondition |
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 216084)
+++ sem_prag.adb (working copy)
@@ -17753,6 +17753,18 @@
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 @@
-- 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 @@
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,
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl (revision 216063)
+++ snames.ads-tmpl (working copy)
@@ -415,6 +415,7 @@
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 @@
Pragma_Partition_Elaboration_Policy,
Pragma_Persistent_BSS,
Pragma_Polling,
+ Pragma_Prefix_Exception_Messages,
Pragma_Priority_Specific_Dispatching,
Pragma_Profile,
Pragma_Profile_Warnings,
