[Ada] Missing interface conversion in access type

[Ada] Missing interface conversion in access type

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 1420 bytes --]

The compiler silently skips the generation of code to perform the
conversion of an access type whose designated type is a class-wide
interface type, thus causing unexpected problems at runtime in
dispatching calls to the target object. After this patch the
following test compiles and executes without errors:

package Lists is
   type List is interface;

   function Element (Self : access List) return Natural is abstract;
end Lists;

limited with Lists;
package Types is
   type List_Access is access all Lists.List'Class;
end Types;

with Types;
with Lists;
with Ada.Finalization;

package My_Lists is
   type My_List is new Ada.Finalization.Controlled
     and Lists.List
       with null record;

   type My_List_Access is access all My_List'Class;

   overriding function Element (Self : access My_List) return Natural
     is (2);
end My_Lists;

with My_Lists;
with Types;
procedure Test is
   X : My_Lists.My_List_Access := new My_Lists.My_List;
   Y : Types.List_Access := Types.List_Access (X);  -- Test
begin
   if Y.Element /= 2 then
      raise Program_Error;
   end if;
end Test;

Command: gnatmake main.adb; ./main
No output

Tested on x86_64-pc-linux-gnu, committed on trunk

2014-11-20  Javier Miranda  <miranda@adacore.com>

	* exp_ch4.adb (Expand_N_Type_Conversion): Add missing implicit
	conversion to force the displacement of the pointer to the object
	to reference the secondary dispatch table.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 513 bytes --]

Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 217828)
+++ exp_ch4.adb	(working copy)
@@ -10622,7 +10622,9 @@
 
             --  Ada 2005 (AI-251): Handle interface type conversion
 
-            if Is_Interface (Actual_Op_Typ) then
+            if Is_Interface (Actual_Op_Typ)
+              or else Is_Interface (Actual_Targ_Typ)
+            then
                Expand_Interface_Conversion (N);
                goto Done;
             end if;