From c14a1ed99c380ae7f812932d8e8f5152bb6c1c19 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 7 Nov 2025 20:42:57 +0100
Subject: [PATCH] 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.
---
 gcc/ada/sem_eval.adb                      |  9 +++++++++
 gcc/testsuite/gnat.dg/class_wide6.adb     |  9 +++++++++
 gcc/testsuite/gnat.dg/class_wide6.ads     | 19 +++++++++++++++++++
 gcc/testsuite/gnat.dg/class_wide6_pkg.ads |  9 +++++++++
 4 files changed, 46 insertions(+)
 create mode 100644 gcc/testsuite/gnat.dg/class_wide6.adb
 create mode 100644 gcc/testsuite/gnat.dg/class_wide6.ads
 create mode 100644 gcc/testsuite/gnat.dg/class_wide6_pkg.ads

diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index f970932df8f..76401495d58 100644
--- 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
index 00000000000..1a9b56a34ec
--- /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
index 00000000000..38c31941f03
--- /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
index 00000000000..e3bf7e9f551
--- /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;
-- 
2.47.3