[gcc r15-1495] ada: Crash on selected component of formal derived type in generic instance

[Marc Poulhi?s]

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

commit r15-1495-gecb84b0aa4eac2050eedd7f9a66dd7393d5d31c2
Author: Gary Dismukes <dismukes@adacore.com>
Date:   Thu May 23 22:06:21 2024 +0000

    ada: Crash on selected component of formal derived type in generic instance
    
    The compiler crashes on an instantiation of a generic child unit G1.GC
    that has a formal private extension P_Ext of a private type P declared
    in the parent G1 whose full type has a component C, when analyzing a
    selected component ACC.C whose prefix is of an access type coming from
    an instantiation of another generic G2 where the designated type is
    the formal type P_Ext (coming in from a formal type of G2).
    
    gcc/ada/
    
            * sem_ch4.adb (Try_Selected_Component_In_Instance): Reverse if_statement
            clauses so that the testing for the special case of extensions of private
            types in instance bodies is done first, followed by the testing for the case
            of a parent type that's a generic actual type. In the extension case, apply
            Base_Type to the type actual in the test of Used_As_Generic_Actual, and add
            a test of Present (Parent_Subtype (Typ)).

Diff:
---
 gcc/ada/sem_ch4.adb | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index e75f8dfb6bcb..1175a34df218 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -5237,22 +5237,6 @@ package body Sem_Ch4 is
             end if;
          end loop;
 
-         --  If Par is a generic actual, look for component in ancestor types.
-         --  Skip this if we have no Declaration_Node, as is the case for
-         --  itypes.
-
-         if Present (Par)
-           and then Is_Generic_Actual_Type (Par)
-           and then Present (Declaration_Node (Par))
-         then
-            Par := Generic_Parent_Type (Declaration_Node (Par));
-            loop
-               Find_Component_In_Instance (Par);
-               exit when Present (Entity (Sel))
-                 or else Par = Etype (Par);
-               Par := Etype (Par);
-            end loop;
-
          --  Another special case: the type is an extension of a private
          --  type T, either is an actual in an instance or is immediately
          --  visible, and we are in the body of the instance, which means
@@ -5263,12 +5247,29 @@ package body Sem_Ch4 is
          --  the Has_Private_View mechanism is bypassed because T or the
          --  ancestor is not directly referenced in the generic body.
 
-         elsif Is_Derived_Type (Typ)
-           and then (Used_As_Generic_Actual (Typ)
+         if Is_Derived_Type (Typ)
+           and then (Used_As_Generic_Actual (Base_Type (Typ))
                       or else Is_Immediately_Visible (Typ))
            and then In_Instance_Body
+           and then Present (Parent_Subtype (Typ))
          then
             Find_Component_In_Instance (Parent_Subtype (Typ));
+
+         --  If Par is a generic actual, look for component in ancestor types.
+         --  Skip this if we have no Declaration_Node, as is the case for
+         --  itypes.
+
+         elsif Present (Par)
+           and then Is_Generic_Actual_Type (Par)
+           and then Present (Declaration_Node (Par))
+         then
+            Par := Generic_Parent_Type (Declaration_Node (Par));
+            loop
+               Find_Component_In_Instance (Par);
+               exit when Present (Entity (Sel))
+                 or else Par = Etype (Par);
+               Par := Etype (Par);
+            end loop;
          end if;
 
          return Etype (N) /= Any_Type;