From: Bob Duff <duff@adacore.com>
Date: Tue, 15 Jun 2021 19:36:34 +0000 (-0400)
Subject: [Ada] Fix crash on type extensions with discriminants
X-Git-Tag: basepoints/gcc-13~6096
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=f377685e3d82193b0f69bb0742e7f470f63532b2;p=thirdparty%2Fgcc.git

[Ada] Fix crash on type extensions with discriminants

gcc/ada/

	* exp_put_image.adb (Make_Component_Attributes): Use
	Implementation_Base_Type to get the parent type. Otherwise,
	Parent_Type_Decl is actually an internally generated subtype
	declaration, so we blow up on
	Type_Definition (Parent_Type_Decl).
---

diff --git a/gcc/ada/exp_put_image.adb b/gcc/ada/exp_put_image.adb
index 082e08b6dde7..87f4b74e35ac 100644
--- a/gcc/ada/exp_put_image.adb
+++ b/gcc/ada/exp_put_image.adb
@@ -658,8 +658,8 @@ package body Exp_Put_Image is
                   if Chars (Defining_Identifier (Item)) = Name_uParent then
                      declare
                         Parent_Type : constant Entity_Id :=
-                          Underlying_Type (Base_Type (
-                            (Etype (Defining_Identifier (Item)))));
+                          Implementation_Base_Type
+                            (Etype (Defining_Identifier (Item)));
 
                         Parent_Aspect_Spec : constant Node_Id :=
                           Find_Aspect (Parent_Type, Aspect_Put_Image);