[gcc r13-7849] ada: Fix internal error on 'Image applied to array component

[gcc r13-7849] ada: Fix internal error on 'Image applied to array component

[Eric Botcazou]

https://gcc.gnu.org/g:f1e55a443e28f4e88e83ce04ac2dc0966dc787a1

commit r13-7849-gf1e55a443e28f4e88e83ce04ac2dc0966dc787a1
Author: Eric Botcazou <ebotcazou@adacore.com>
Date:   Thu Jan 26 18:16:14 2023 +0100

    ada: Fix internal error on 'Image applied to array component
    
    This happens because the array component depends on a discriminant.
    
    gcc/ada/
    
            * exp_imgv.adb (Rewrite_Object_Image): If the prefix is a component
            that depends on a discriminant, create an actual subtype for it.

Diff:
---
 gcc/ada/exp_imgv.adb | 23 +++++++++++++++++++++--
 1 file changed, 21 insertions(+), 2 deletions(-)

diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb
index 93fdb70306f..257f65badd0 100644
--- a/gcc/ada/exp_imgv.adb
+++ b/gcc/ada/exp_imgv.adb
@@ -2498,12 +2498,31 @@ package body Exp_Imgv is
       Attr_Name : Name_Id;
       Str_Typ   : Entity_Id)
    is
+      Ptyp : Entity_Id;
+
    begin
+      Ptyp := Etype (Pref);
+
+      --  If the prefix is a component that depends on a discriminant, then
+      --  create an actual subtype for it.
+
+      if Nkind (Pref) = N_Selected_Component then
+         declare
+            Decl : constant Node_Id :=
+                     Build_Actual_Subtype_Of_Component (Ptyp, Pref);
+         begin
+            if Present (Decl) then
+               Insert_Action (N, Decl);
+               Ptyp := Defining_Identifier (Decl);
+            end if;
+         end;
+      end if;
+
       Rewrite (N,
         Make_Attribute_Reference (Sloc (N),
-          Prefix         => New_Occurrence_Of (Etype (Pref), Sloc (N)),
+          Prefix         => New_Occurrence_Of (Ptyp, Sloc (N)),
           Attribute_Name => Attr_Name,
-          Expressions    => New_List (Relocate_Node (Pref))));
+          Expressions    => New_List (Unchecked_Convert_To (Ptyp, Pref))));
 
       Analyze_And_Resolve (N, Str_Typ);
    end Rewrite_Object_Image;