diff mbox series

[COMMITTED] ada: Fix internal error on 'Image applied to array component

Message ID 20230516084129.1502331-1-poulhies@adacore.com
State Accepted
Headers
Series [COMMITTED] ada: Fix internal error on 'Image applied to array component |

Checks

Context Check Description
snail/gcc-patch-check success Github commit url

Commit Message

Marc Poulhiès May 16, 2023, 8:41 a.m. UTC 
  From: Eric Botcazou <ebotcazou@adacore.com>

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.

Tested on x86_64-pc-linux-gnu, committed on master.

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

Patch

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;