A view conversion to an interface type is expanded into a dereference of a
temporary that involves the class-wide interface type. Nevertheless such an
expression is not dynamically tagged, and is not a controlling argument in
a call.
Compiling main.adb must be rejected with:
main.adb:8:10: call to abstract procedure must be dispatching
---
with Types; use Types;
procedure Main is
V : R;
begin
I (V).P1;
I'Class (V).P1;
I (V).P2;
I'Class (V).P2;
end Main;
---
package Types is
type I is interface;
procedure P1 (V : I) is null;
procedure P2 (V : I) is abstract;
type R is new I with null record;
procedure P2 (V : R) is null;
end Types;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-05 Ed Schonberg <schonb...@adacore.com>
* sem_disp.adb (Find_Controlling_Arg): Add checks for
interface type conversions, that are expanded into dereferences.
Index: sem_disp.adb
===================================================================
--- sem_disp.adb (revision 178381)
+++ sem_disp.adb (working copy)
@@ -1616,6 +1616,32 @@
then
return Controlling_Argument (Orig_Node);
+ -- Type conversions are dynamically tagged if the target type, or its
+ -- designated type, are classwide. An interface conversion expands into
+ -- a dereference, so test must be performed on the original node.
+
+ elsif Nkind (Orig_Node) = N_Type_Conversion
+ and then Nkind (N) = N_Explicit_Dereference
+ and then Is_Controlling_Actual (N)
+ then
+ declare
+ Target_Type : constant Entity_Id :=
+ Entity (Subtype_Mark (Orig_Node));
+
+ begin
+ if Is_Class_Wide_Type (Target_Type) then
+ return N;
+
+ elsif Is_Access_Type (Target_Type)
+ and then Is_Class_Wide_Type (Designated_Type (Target_Type))
+ then
+ return N;
+
+ else
+ return Empty;
+ end if;
+ end;
+
-- Normal case
elsif Is_Controlling_Actual (N)
