From: Ed Schonberg <schonberg@adacore.com>
Date: Mon, 29 Jun 2020 21:06:42 +0000 (-0400)
Subject: [Ada] Attribute Img on derived types
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=5742eed7a6e567c3fc28adea17d0788ea4be136f;p=gcc.git

[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 --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