]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Crash on selected component of formal derived type in generic instance
authorGary Dismukes <dismukes@adacore.com>
Thu, 23 May 2024 22:06:21 +0000 (22:06 +0000)
committerMarc Poulhiès <poulhies@adacore.com>
Thu, 20 Jun 2024 08:50:57 +0000 (10:50 +0200)
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)).

gcc/ada/sem_ch4.adb

index e75f8dfb6bcb75931fdfab087e558392a1e6c023..1175a34df218340d1e1b46a16ff684b7cfb01992 100644 (file)
@@ -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;