[Ada] Wrong type conversion on access to limited-with interface

[Arnaud Charlet <charlet at adacore dot com>]

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  <miranda@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.

Attachment: difs
Description: Text document