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 2002cc7621fde11273be21210dd9097f1c602e6d..989e6bfd2d010f847c09ffaade27c7b095a6b034 100644 (file)
--- 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 (file)
index 0000000..0367302
--- /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 (file)
index 0000000..558246c
--- /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;