If the type of the operand of a type conversion is defined as an access to a class-wide interface type, and the target interface type is defined in a package visible at the point of declaration of the access type through a limited-with clause, then the compiler may silently skip generating code for the type conversion.
After this patch the following the compiler passes this test. with System; use System; package Lib is end; package Lib.Pkg_1 is type Iface0 is limited interface; function GetAddr (Self : access Iface0) return Address is abstract; end; with Lib.Pkg_3; with Lib.Pkg_1; use Lib.Pkg_1; package Lib.Pkg_2 is type Iface1 is limited interface and Iface0; end; limited with Lib.Pkg_2; package Lib.Pkg_3 is type Iface2 is limited interface; type Iface1_Access is access all Lib.Pkg_2.Iface1'Class; procedure Iface_Prim (Self : access Iface2; The_Reader : Iface1_Access) is abstract; end; with Lib.Pkg_2; use Lib.Pkg_2; with Lib.Pkg_1; use Lib.Pkg_1; package Lib.Domain_Entity is type Root is tagged record Value : Address; end record; procedure SetAddr (Self : access Root; To : Address); function GetAddr (Self : access Root) return Address; type DT2 is new Root and Iface1 with null record; type DT2_Access is access all DT2'Class; end; package body Lib.Domain_Entity is function GetAddr (Self : access Root) return Address is begin return Self.Value; end; procedure SetAddr (Self : access Root; To : Address) is begin Self.Value := To; end; end; with Lib.Pkg_2; use Lib.Pkg_2; with Lib.Pkg_3; use Lib.Pkg_3; generic type Formal_Type is limited new Iface1 with private; package Testgen_2 is type Object is limited new Iface2 with null record; type Class_Reference is access all Object'Class; procedure Do_Test (This : access Object; The_Reader : Iface1_Access); overriding procedure Iface_Prim (This : access Object; The_Reader : Iface1_Access); end; with GNAT.IO; use GNAT.IO; with System.Address_Image; package body Testgen_2 is procedure Do_Test (This : access Object; The_Reader : Iface1_Access) is begin This.Iface_Prim (The_Reader); end; overriding procedure Iface_Prim (This : access Object; The_Reader : Iface1_Access) is Reader : access Formal_Type; Addr_1 : System.Address; Addr_2 : System.Address; use type System.Address; begin Addr_1 := The_Reader.GetAddr; Reader := Formal_Type (The_Reader.all)'Unrestricted_Access; Addr_2 := Reader.GetAddr; if Addr_1 = Addr_2 then Put_Line ("OK: correct output"); else Put_Line ("test FAILED"); Put_Line (System.Address_Image (Addr_1)); Put_Line (System.Address_Image (Addr_2)); end if; end; end; with Testgen_2; with Lib.Domain_Entity; use Lib.Domain_Entity; package Test_Gen_Instance is new Testgen_2 (DT2); with Lib.Domain_Entity; use Lib.Domain_Entity; with Test_Gen_Instance; procedure Test_Main is Read : DT2_Access; T1 : aliased Test_Gen_Instance.Object; begin Read := new DT2; Read.SetAddr (Read'Address); T1.Do_Test (The_Reader => Read.all'Access); end; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-02-20 Javier Miranda <mira...@adacore.com> * sem_res.adb (Resolve_Type_Conversion): If the type of the operand is the limited-view of a class-wide type then recover the class-wide type of the non-limited view.
Index: sem_res.adb =================================================================== --- sem_res.adb (revision 220836) +++ sem_res.adb (working copy) @@ -10715,14 +10715,22 @@ begin -- If the type of the operand is a limited view, use the non- - -- limited view when available. + -- limited view when available. If it is a class-wide type, + -- recover class_wide type of the non-limited view. - if From_Limited_With (Opnd) - and then Ekind (Opnd) in Incomplete_Kind - and then Present (Non_Limited_View (Opnd)) - then - Opnd := Non_Limited_View (Opnd); - Set_Etype (Expression (N), Opnd); + if From_Limited_With (Opnd) then + if Ekind (Opnd) in Incomplete_Kind + and then Present (Non_Limited_View (Opnd)) + then + Opnd := Non_Limited_View (Opnd); + Set_Etype (Expression (N), Opnd); + + elsif Is_Class_Wide_Type (Opnd) + and then Present (Non_Limited_View (Etype (Opnd))) + then + Opnd := Class_Wide_Type (Non_Limited_View (Etype (Opnd))); + Set_Etype (Expression (N), Opnd); + end if; end if; if Is_Access_Type (Opnd) then