This patch fixes the handling of the Ada_2020 attribute Img when applied
to derived types. If the type is private it is necessary to retrieve a
non-private description of the type structure, by using an underlying
view (which crosses the privacy boundary). The underlying view is that
of the base type of the object, but not its root type, which might
ignore components of a type extension and produce spurious type errors.
Tested on x86_64-pc-linux-gnu, committed on trunk
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 --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
--- 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
