[Ada] Attribute Img on derived types
authorEd Schonberg <schonberg@adacore.com>
Mon, 29 Jun 2020 21:06:42 +0000 (17:06 -0400)
committerPierre-Marie de Rodat <derodat@adacore.com>
Fri, 16 Oct 2020 07:33:21 +0000 (03:33 -0400)
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.

gcc/ada/exp_imgv.adb

index 41e4b1b454e76c79bdf53fda23f936eee185b1d3..731d01062e5366ac4f05d8ecd4c894d4932d3a61 100644 (file)
@@ -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