===================================================================
@@ -876,10 +876,13 @@ package body Sem_Type is
return False;
end;
- -- In a dispatching call the actual may be class-wide
+ -- In a dispatching call the actual may be class-wide, the formal
+ -- may be its specific type, or that of a descendent of it.
elsif Is_Class_Wide_Type (T2)
- and then Base_Type (Root_Type (T2)) = Base_Type (T1)
+ and then
+ (Class_Wide_Type (T1) = T2
+ or else Base_Type (Root_Type (T2)) = Base_Type (T1))
then
return True;
This patch simplifies type compatibility checks when one of the types is class- wide, and the other is the specific type, which is a private extension that constrains the discriminant of its parent. The following must compile quietly: gcc -c main.adb with P; procedure Main is procedure Test (Left : access P.Child_1_3'Class; Right : access P.Child_1_3'Class) is begin if P."=" (Left.all, Right.all) then null; end if; end Test; null; end Main; package P is type Root_1 (V : Integer) is tagged record F : Integer := 15; end record; type Child_1_3 is new Root_1 (1) with private; private type Child_1_3 is new Root_1 (1) with null record; end P; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-05 Ed Schonberg <schonberg@adacore.com> * sem_type.adb (Covers): In a dispatching context, T1 covers T2 if T2 is class-wide and T1 is its specific type.