diff mbox series

[COMMITTED,26/30] ada: Crash on selected component of formal derived type in generic instance

Message ID 20240620085321.2412421-26-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/30] ada: Fix list of attributes defined by Ada 2022 | expand

Commit Message

Marc Poulhiès June 20, 2024, 8:53 a.m. UTC
From: Gary Dismukes <dismukes@adacore.com>

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)).

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

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

Patch

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index e75f8dfb6bc..1175a34df21 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;