Ada: Fix bogus error on inherited operation for extension of type instance

It comes from a small discrepancy between class-wide subtypes and types:
they both have unknown discriminants, but only the latter may have
discriminants, which causes Subtypes_Statically_Match to return False.

gcc/ada/
	PR ada/83188
	* sem_eval.adb (Subtypes_Statically_Match): Deal with class-wide
	subtypes whose class-wide types have discriminants.

gcc/testsuite/
	* gnat.dg/class_wide6.ads, gnat.dg/class_wide6.adb: New test.
	* gnat.dg/class_wide6_pkg.ads: New helper.

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index f970932df8f96e86021b76ef0597fd26a2434b6f..76401495d5880d8eec2806f91011ba27ffd27d49 100644 (file)
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -6837,6 +6837,15 @@ package body Sem_Eval is
          then
             return True;
 
+         --  Handle class-wide subtypes, which never have discriminants, while
+         --  class-wide types may have them (but they are always unknown).
+
+         elsif Ekind (T2) = E_Class_Wide_Subtype and then Etype (T2) = T1 then
+            return True;
+
+         elsif Ekind (T1) = E_Class_Wide_Subtype and then Etype (T1) = T2 then
+            return True;
+
          --  Because of view exchanges in multiple instantiations, conformance
          --  checking might try to match a partial view of a type with no
          --  discriminants with a full view that has defaulted discriminants.

diff --git a/gcc/testsuite/gnat.dg/class_wide6.adb b/gcc/testsuite/gnat.dg/class_wide6.adb
new file mode 100644 (file)
index 0000000..1a9b56a
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/class_wide6.adb
@@ -0,0 +1,9 @@
+package body Class_Wide6 is
+
+   function Parse (Parser: Script_Info_Parser) return Script_Info'Class is
+   begin
+      pragma Warnings(Off);
+      return Parse (Parser);
+   end;
+
+end Class_Wide6;

diff --git a/gcc/testsuite/gnat.dg/class_wide6.ads b/gcc/testsuite/gnat.dg/class_wide6.ads
new file mode 100644 (file)
index 0000000..38c3194
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/class_wide6.ads
@@ -0,0 +1,19 @@
+--  { dg-do compile }
+
+with Class_Wide6_Pkg;
+
+package Class_Wide6 is
+
+   type Script_Kind_Enum is (Transformer, Validator);
+
+   type Script_Info (Script_Kind : Script_Kind_Enum) is tagged null record;
+
+   package Base_Script_Info_Node is new Class_Wide6_Pkg (Script_Info'Class);
+
+   type Script_Info_Parser is new Base_Script_Info_Node.Base_Node_Parser with
+      null record;
+
+   overriding function Parse (Parser: Script_Info_Parser)
+                              return Script_Info'Class;
+
+end Class_Wide6;

diff --git a/gcc/testsuite/gnat.dg/class_wide6_pkg.ads b/gcc/testsuite/gnat.dg/class_wide6_pkg.ads
new file mode 100644 (file)
index 0000000..e3bf7e9
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/class_wide6_pkg.ads
@@ -0,0 +1,9 @@
+generic
+   type Data_Type (<>) is private;
+package Class_Wide6_Pkg is
+
+   type Base_Node_Parser is abstract tagged limited null record;
+
+   function Parse (Parser: Base_Node_Parser) return Data_Type is abstract;
+
+end Class_Wide6_Pkg;