From: Etienne Servais <servais@adacore.com>
Date: Wed, 2 Feb 2022 14:18:29 +0000 (+0100)
Subject: [Ada] Do not create useless itype in Constrain_Access
X-Git-Tag: basepoints/gcc-14~6900
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=e6f7d5ff4f990c8f614c654353a3aa843f009349;p=thirdparty%2Fgcc.git

[Ada] Do not create useless itype in Constrain_Access

In the case of a constrained access definition for a record component we
are calling create_itype twice the former not being updated.  This leads
to a malformed node that crashes -gnatG when predicates are activated.
Instead of creating a default Itype for Desig_Subtype, create it with
the correct scope in each case.

gcc/ada/

	* sem_ch3.adb (Constrain_Access): Call Desig_Subtype in each if
	branch to avoid calling it twice.
---

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d4464e2b8c9..6559c8fc7b7 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -13345,11 +13345,12 @@ package body Sem_Ch3 is
    is
       T             : constant Entity_Id := Entity (Subtype_Mark (S));
       Desig_Type    : constant Entity_Id := Designated_Type (T);
-      Desig_Subtype : Entity_Id := Create_Itype (E_Void, Related_Nod);
+      Desig_Subtype : Entity_Id;
       Constraint_OK : Boolean := True;
 
    begin
       if Is_Array_Type (Desig_Type) then
+         Desig_Subtype := Create_Itype (E_Void, Related_Nod);
          Constrain_Array (Desig_Subtype, S, Related_Nod, Def_Id, 'P');
 
       elsif (Is_Record_Type (Desig_Type)
@@ -13445,12 +13446,14 @@ package body Sem_Ch3 is
             end;
          end if;
 
+         Desig_Subtype := Create_Itype (E_Void, Related_Nod);
          Constrain_Discriminated_Type (Desig_Subtype, S, Related_Nod,
            For_Access => True);
 
       elsif Is_Concurrent_Type (Desig_Type)
         and then not Is_Constrained (Desig_Type)
       then
+         Desig_Subtype := Create_Itype (E_Void, Related_Nod);
          Constrain_Concurrent (Desig_Subtype, S, Related_Nod, Desig_Type, ' ');
 
       else