diff options
| author | Ed Schonberg <schonberg@adacore.com> | 2020-06-29 17:06:42 -0400 |
|---|---|---|
| committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-10-16 03:33:21 -0400 |
| commit | 5742eed7a6e567c3fc28adea17d0788ea4be136f (patch) | |
| tree | 8682c7f1cec3086e6b97ec3dc1c88ef6b0ab2625 /gcc | |
| parent | d22f3eabf11d403a4885b986b33006d21dc431ba (diff) | |
| download | gcc-5742eed7a6e567c3fc28adea17d0788ea4be136f.zip gcc-5742eed7a6e567c3fc28adea17d0788ea4be136f.tar.gz gcc-5742eed7a6e567c3fc28adea17d0788ea4be136f.tar.bz2 | |
[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.
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/exp_imgv.adb | 20 |
1 files changed, 8 insertions, 12 deletions
diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 41e4b1b..731d010 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 |