This patch extends the functionality of pragma Discard_Names to suppress the
generation of the String names of exception declarations. As a result, these
names do not appear in the final binary. A side effect of this functionality
is that routine Ada.Exceptions.Exception_Name will return an empty String.
------------
-- Source --
------------
-- gnat.adc
pragma Discard_Names;
-- pack.ads
package Pack is
External_Exception : exception;
procedure Raise_EE (Do_It : Boolean);
end Pack;
-- pack.adb
with Ada.Text_IO; use Ada.Text_IO;
package body Pack is
procedure Raise_EE (Do_It : Boolean) is
begin
if Do_It then
Put_Line ("about to raise External_Exception");
raise External_Exception;
end if;
end Raise_EE;
end Pack;
-- main.adb
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Text_IO; use Ada.Text_IO;
with Pack; use Pack;
procedure Main is
Local_Exception : exception;
procedure Iterate_Over (High : Natural) is
begin
for Iter in 0 .. High loop
begin
Raise_EE (Iter mod 13 = 0);
exception
when External_Exception =>
Put_Line ("caught External_Exception");
end;
end loop;
raise Local_Exception;
end Iterate_Over;
begin
Put_Line (Exception_Name (External_Exception'Identity));
Put_Line (Exception_Name (Local_Exception'Identity));
Iterate_Over (15);
exception
when Local_Exception =>
Put_Line ("caught Local_Exception");
end Main;
----------------------------
-- Compilation and output --
----------------------------
$ gnatmake -q main.adb
$ main
$ grep -c "EXTERNAL_EXCEPTION" main
$ grep -c "LOCAL_EXCEPTION" main
about to raise External_Exception
caught External_Exception
about to raise External_Exception
caught External_Exception
caught Local_Exception
0
0
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-01-23 Hristian Kirtchev <kirtc...@adacore.com>
* exp_ch11.adb (Expand_N_Exception_Declaration): Generate an
empty name when the exception declaration is subject to pragma
Discard_Names.
(Null_String): New routine.
Index: exp_ch11.adb
===================================================================
--- exp_ch11.adb (revision 244773)
+++ exp_ch11.adb (working copy)
@@ -1171,11 +1171,8 @@
-- end if;
procedure Expand_N_Exception_Declaration (N : Node_Id) is
- Id : constant Entity_Id := Defining_Identifier (N);
- Loc : constant Source_Ptr := Sloc (N);
- Ex_Id : Entity_Id;
- Flag_Id : Entity_Id;
- L : List_Id;
+ Id : constant Entity_Id := Defining_Identifier (N);
+ Loc : constant Source_Ptr := Sloc (N);
procedure Force_Static_Allocation_Of_Referenced_Objects
(Aggregate : Node_Id);
@@ -1205,6 +1202,9 @@
-- references to other local (non-hoisted) objects (e.g., in the initial
-- value expression).
+ function Null_String return String_Id;
+ -- Build a null-terminated empty string
+
---------------------------------------------------
-- Force_Static_Allocation_Of_Referenced_Objects --
---------------------------------------------------
@@ -1248,6 +1248,24 @@
Fixup_Tree (Aggregate);
end Force_Static_Allocation_Of_Referenced_Objects;
+ -----------------
+ -- Null_String --
+ -----------------
+
+ function Null_String return String_Id is
+ begin
+ Start_String;
+ Store_String_Char (Get_Char_Code (ASCII.NUL));
+ return End_String;
+ end Null_String;
+
+ -- Local variables
+
+ Ex_Id : Entity_Id;
+ Ex_Val : String_Id;
+ Flag_Id : Entity_Id;
+ L : List_Id;
+
-- Start of processing for Expand_N_Exception_Declaration
begin
@@ -1262,14 +1280,25 @@
Ex_Id :=
Make_Defining_Identifier (Loc, New_External_Name (Chars (Id), 'E'));
+ -- Do not generate an external name if the exception declaration is
+ -- subject to pragma Discard_Names. Use a null-terminated empty name
+ -- to ensure that Ada.Exceptions.Exception_Name functions properly.
+
+ if Global_Discard_Names or else Discard_Names (Ex_Id) then
+ Ex_Val := Null_String;
+
+ -- Otherwise generate the fully qualified name of the exception
+
+ else
+ Ex_Val := Fully_Qualified_Name_String (Id);
+ end if;
+
Insert_Action (N,
Make_Object_Declaration (Loc,
Defining_Identifier => Ex_Id,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
- Expression =>
- Make_String_Literal (Loc,
- Strval => Fully_Qualified_Name_String (Id))));
+ Expression => Make_String_Literal (Loc, Ex_Val)));
Set_Is_Statically_Allocated (Ex_Id);
