https://gcc.gnu.org/g:c14a1ed99c380ae7f812932d8e8f5152bb6c1c19
commit r16-5082-gc14a1ed99c380ae7f812932d8e8f5152bb6c1c19 Author: Eric Botcazou <[email protected]> Date: Fri Nov 7 20:42:57 2025 +0100 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: --- 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(+) diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index f970932df8f9..76401495d588 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 000000000000..1a9b56a34ec4 --- /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 000000000000..38c31941f03d --- /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 000000000000..e3bf7e9f551b --- /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;
