===================================================================
@@ -1533,20 +1533,22 @@ package body Exp_Disp is
Formal := First (Formals);
while Present (Formal) loop
- -- Handle concurrent types
+ -- If the parent is a constrained discriminated type, then the
+ -- primitive operation will have been defined on a first subtype.
+ -- For proper matching with controlling type, use base type.
if Ekind (Target_Formal) = E_In_Parameter
and then Ekind (Etype (Target_Formal)) = E_Anonymous_Access_Type
then
- Ftyp := Directly_Designated_Type (Etype (Target_Formal));
+ Ftyp :=
+ Base_Type (Directly_Designated_Type (Etype (Target_Formal)));
else
- -- If the parent is a constrained discriminated type, then the
- -- primitive operation will have been defined on a first subtype.
- -- For proper matching with controlling type, use base type.
-
Ftyp := Base_Type (Etype (Target_Formal));
end if;
+ -- For concurrent types, the relevant info is on the corresponding_
+ -- record type.
+
if Is_Concurrent_Type (Ftyp) then
Ftyp := Corresponding_Record_Type (Ftyp);
end if;
If the parent type in a type extension is a discriminated type with constraints, the compiler creates an anonymous base type for it, and makes the source type into a subtype of this base. If an overridden operation of a progenitor of the type extension has an access parameter, the interface thunk for the overriding operation must use this anonymous base type in the constructed call to the overriding subprogram, to avois spurious type errors. The following must compile and execute quietly: --- package Ref is type I is interface; procedure P (V : access I) is abstract; type C is record V : access I'Class; end record; type Root (V : Integer) is tagged null record; type Child is new Root (1) with null record; type Grand_Child is new Child and I with record null; end record; procedure P (V : access Grand_Child); end Ref; --- package body Ref is procedure P (V : access Grand_Child) is begin null; end; end Ref; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-17 Ed Schonberg <schonberg@adacore.com> * exp_disp.adb (Build_Interface_Thunk): Use base type of formal to determine whether it has the controlling type, when the formal is an access parameter.