From: Eric Botcazou <ebotcazou@adacore.com>
Date: Mon, 27 Oct 2025 18:51:11 +0000 (+0100)
Subject: Ada: Fix assertion failure on child generic package
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=76943639ddd861dce3886d1def2a353ccfcdd585;p=thirdparty%2Fgcc.git

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 --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 2002cc7621f..989e6bfd2d0 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 00000000000..0367302eef3
--- /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 00000000000..558246caf2e
--- /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;