[gcc r11-3989] [Ada] Attribute Img on derived types
Pierre-Marie de Rodat
pmderodat@gcc.gnu.org
Fri Oct 16 07:37:26 GMT 2020
https://gcc.gnu.org/g:5742eed7a6e567c3fc28adea17d0788ea4be136f
commit r11-3989-g5742eed7a6e567c3fc28adea17d0788ea4be136f
Author: Ed Schonberg <schonberg@adacore.com>
Date: Mon Jun 29 17:06:42 2020 -0400
[Ada] Attribute Img on derived types
gcc/ada/
* exp_imgv.adb (Expand_Image_Attribute): Use the base type
instead of the root type when type of object is private. Remove
Ada_2020 guard, because it has been checked during prior
analysis. Use Underlying_Type in all cases, as it is a no-op on
types that are not private.
Diff:
---
gcc/ada/exp_imgv.adb | 20 ++++++++------------
1 file changed, 8 insertions(+), 12 deletions(-)
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 41e4b1b454e..731d01062e5 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -479,14 +479,11 @@ package body Exp_Imgv is
Ptyp := Entity (Pref);
- -- Ada 2020 allows 'Image on private types, so we need to fetch the
- -- underlying type.
+ -- Ada 2020 allows 'Image on private types, so fetch the underlying
+ -- type to obtain the structure of the type. We use the base type,
+ -- not the root type, to handle properly derived types.
- if Ada_Version >= Ada_2020 then
- Rtyp := Underlying_Type (Root_Type (Ptyp));
- else
- Rtyp := Root_Type (Ptyp);
- end if;
+ Rtyp := Underlying_Type (Base_Type (Ptyp));
-- Enable speed-optimized expansion of user-defined enumeration types
-- if we are compiling with optimizations enabled and enumeration type
@@ -657,9 +654,10 @@ package body Exp_Imgv is
T : Entity_Id;
begin
-- In Ada 2020 we need the underlying type here, because 'Image is
- -- allowed on private types.
+ -- allowed on private types. We have already checked the version
+ -- when resolving the attribute.
- if Ada_Version >= Ada_2020 then
+ if Is_Private_Type (Ptyp) then
T := Rtyp;
else
T := Ptyp;
@@ -683,9 +681,7 @@ package body Exp_Imgv is
declare
Conv : Node_Id;
begin
- if Ada_Version >= Ada_2020
- and then Is_Private_Type (Etype (Expr))
- then
+ if Is_Private_Type (Etype (Expr)) then
if Is_Fixed_Point_Type (Rtyp) then
Conv := Convert_To (Tent, OK_Convert_To (Rtyp, Expr));
else
More information about the Gcc-cvs
mailing list