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
This commit is contained in:
Robert Dewar
Arnaud Charlet
parent
d6cd5d3493
commit
8f8194710d
12 changed files with 284 additions and 64 deletions
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -1275,6 +1275,7 @@ begin
|
|||
Pragma_Passive |
|
||||
Pragma_Preelaborable_Initialization |
|
||||
Pragma_Polling |
|
||||
Pragma_Prefix_Exception_Messages |
|
||||
Pragma_Persistent_BSS |
|
||||
Pragma_Post |
|
||||
Pragma_Postcondition |
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue