https://gcc.gnu.org/g:76943639ddd861dce3886d1def2a353ccfcdd585
commit r16-4666-g76943639ddd861dce3886d1def2a353ccfcdd585 Author: Eric Botcazou <[email protected]> Date: Mon Oct 27 19:51:11 2025 +0100 Ada: Fix assertion failure on child generic package That's an oversight in Declare_Inherited_Private_Subprograms, which does not deal with formal types specially as it should per RM 3.2.3(7.d/2). gcc/ada/ PR ada/29958 * sem_ch7.adb (Declare_Inherited_Private_Subprograms): Deal with formal types specially. gcc/testsuite/ * gnat.dg/specs/private3-child.ads: New test. * gnat.dg/specs/private3.ads: New helper. Diff: --- gcc/ada/sem_ch7.adb | 27 +++++++++++++++++++++++++- gcc/testsuite/gnat.dg/specs/private3-child.ads | 11 +++++++++++ gcc/testsuite/gnat.dg/specs/private3.ads | 9 +++++++++ 3 files changed, 46 insertions(+), 1 deletion(-) diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 2002cc7621fd..989e6bfd2d01 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2266,7 +2266,32 @@ package body Sem_Ch7 is Next_Elmt (Op_Elmt_2); end loop; - -- Case 2: We have not found any explicit overriding and + -- Case 2: For a formal type, we need to explicitly check + -- whether a local subprogram hides from all visibility + -- the implicitly declared primitive, because subprograms + -- declared in a generic package specification are never + -- primitive for a formal type, even if they happen to + -- override an operation of the type (RM 3.2.3(7.d/2)). + + if Is_Generic_Type (E) then + declare + S : Entity_Id; + + begin + S := E; + while Present (S) loop + if Chars (S) = Chars (Parent_Subp) + and then Type_Conformant (Prim_Op, S) + then + goto Next_Primitive; + end if; + + Next_Entity (S); + end loop; + end; + end if; + + -- Case 3: We have not found any explicit overriding and -- hence we need to declare the operation (i.e., make it -- visible). diff --git a/gcc/testsuite/gnat.dg/specs/private3-child.ads b/gcc/testsuite/gnat.dg/specs/private3-child.ads new file mode 100644 index 000000000000..0367302eef33 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/private3-child.ads @@ -0,0 +1,11 @@ +-- { dg-do compile } + +generic + + type Ext is new T with private; + +package Private3.Child is + + procedure P_Private (X : in out Ext) is null; + +end Private3.Child; diff --git a/gcc/testsuite/gnat.dg/specs/private3.ads b/gcc/testsuite/gnat.dg/specs/private3.ads new file mode 100644 index 000000000000..558246caf2ee --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/private3.ads @@ -0,0 +1,9 @@ +package Private3 is + + type T is tagged null record; + +private + + procedure P_Private (X : in out T) is null; + +end Private3;
