https://gcc.gnu.org/g:a311db8758b573494211735412f0228f4efe120d
commit r15-722-ga311db8758b573494211735412f0228f4efe120d
Author: Piotr Trojanek <troja...@adacore.com>
Date: Fri Mar 22 23:11:10 2024 +0100
ada: Do not leak tagged type names when Discard_Names is enabled
When both pragmas Discard_Names and No_Tagged_Streams apply to a tagged
type, the intended behavior is to prevent type names from leaking into
object code, as documented in GNAT RM.
However, while Discard_Names can be used as a configuration pragma,
No_Tagged_Streams must be applied to each type separately. This patch
enables the use of restriction No_Streams, which can be activated
globally, instead of No_Tagged_Streams on individual types.
When no tagged stream object can be created and allocated, then routines
that make use of the External_Tag won't be used.
gcc/ada/
* doc/gnat_rm/implementation_defined_pragmas.rst
(No_Tagged_Streams): Document how to avoid exposing entity names
for the entire partition.
* exp_disp.adb (Make_DT): Make use of restriction No_Streams.
* exp_put_image.adb (Build_Record_Put_Image_Procedure): Respect
Discard_Names in the generated Put_Image procedure.
* gnat_rm.texi: Regenerate.
Diff:
---
.../doc/gnat_rm/implementation_defined_pragmas.rst | 6 ++++
gcc/ada/exp_disp.adb | 5 ++--
gcc/ada/exp_put_image.adb | 34 +++++++++++++++++-----
gcc/ada/gnat_rm.texi | 6 ++++
4 files changed, 41 insertions(+), 10 deletions(-)
diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
index 0661670e047..7e4dd935342 100644
--- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
+++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst
@@ -4000,6 +4000,12 @@ applied to a tagged type its Expanded_Name and
External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
+Alternatively, when pragmas ``Discard_Names`` and ``Restrictions (No_Streams)``
+simultanously apply to a tagged type, its Expanded_Name and External_Tag are
+also initialized with empty strings. In particular, both these pragmas can be
+applied as configuration pragmas to avoid exposing entity names at binary
+level for the entire parition.
+
Pragma Normalize_Scalars
========================
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 601d463a8b0..66be77c9ffc 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -4600,8 +4600,9 @@ package body Exp_Disp is
-- streams.
Discard_Names : constant Boolean :=
- Present (No_Tagged_Streams_Pragma (Typ))
- and then
+ (Present (No_Tagged_Streams_Pragma (Typ))
+ or else Restriction_Active (No_Streams))
+ and then
(Global_Discard_Names or else Einfo.Entities.Discard_Names (Typ));
-- The following name entries are used by Make_DT to generate a number
diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 09fbfa75eeb..94299e39661 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -44,6 +44,7 @@ with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
with Stand;
+with Stringt; use Stringt;
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
@@ -825,14 +826,31 @@ package body Exp_Put_Image is
Make_Raise_Program_Error (Loc,
Reason => PE_Explicit_Raise));
else
- Append_To (Stms,
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (RTE (RE_Put_Image_Unknown), Loc),
- Parameter_Associations => New_List
- (Make_Identifier (Loc, Name_S),
- Make_String_Literal (Loc,
- Fully_Qualified_Name_String
- (Btyp, Append_NUL => False)))));
+ declare
+ Type_Name : String_Id;
+ begin
+ -- If aspect Discard_Names is enabled the intention is to
+ -- prevent type names from leaking into object file. Instead,
+ -- we emit string that is different from the ones from the
+ -- default implementations of the Put_Image attribute.
+
+ if Global_Discard_Names or else Discard_Names (Typ) then
+ Start_String;
+ Store_String_Chars ("(DISCARDED TYPE NAME)");
+ Type_Name := End_String;
+ else
+ Type_Name :=
+ Fully_Qualified_Name_String (Btyp, Append_NUL => False);
+ end if;
+
+ Append_To (Stms,
+ Make_Procedure_Call_Statement (Loc,
+ Name => New_Occurrence_Of (RTE (RE_Put_Image_Unknown), Loc),
+ Parameter_Associations => New_List
+ (Make_Identifier (Loc, Name_S),
+ Make_String_Literal (Loc,
+ Type_Name))));
+ end;
end if;
elsif Is_Null_Record_Type (Btyp, Ignore_Privacy => True) then
diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi
index 4dbbb036a25..4ff1de42db2 100644
--- a/gcc/ada/gnat_rm.texi
+++ b/gcc/ada/gnat_rm.texi
@@ -5535,6 +5535,12 @@ applied to a tagged type its Expanded_Name and
External_Tag are initialized
with empty strings. This is useful to avoid exposing entity names at binary
level but has a negative impact on the debuggability of tagged types.
+Alternatively, when pragmas @code{Discard_Names} and @code{Restrictions
(No_Streams)}
+simultanously apply to a tagged type, its Expanded_Name and External_Tag are
+also initialized with empty strings. In particular, both these pragmas can be
+applied as configuration pragmas to avoid exposing entity names at binary
+level for the entire parition.
+
@node Pragma Normalize_Scalars,Pragma Obsolescent,Pragma
No_Tagged_Streams,Implementation Defined Pragmas
@anchor{gnat_rm/implementation_defined_pragmas
pragma-normalize-scalars}@anchor{b0}
@section Pragma Normalize_Scalars
