[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