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 incorrectly return False.
Tested on x86-64/Linux, applied on the mainline.
2025-11-07 Eric Botcazou <[email protected]>
PR ada/83188
* sem_eval.adb (Subtypes_Statically_Match): Deal with class-wide
subtypes whose class-wide types have discriminants.
2025-11-07 Eric Botcazou <[email protected]>
* gnat.dg/class_wide6.ads, gnat.dg/class_wide6.adb: New test.
* gnat.dg/class_wide6_pkg.ads: New helper.
--
Eric Botcazoudiff --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.
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;
-- { 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;
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;
