[Ada] Wrong dispatching call through class-wide interface subtype

[Arnaud Charlet <charlet at adacore dot com>]

When the type of the controlling formal of a dispatching call is an
interface subtype the compiler can generate code that dispatch to
the wrong operation or crash the program.

After this patch the following test compiles and executes well.

package Small_Types is
   type I_Dummy is limited interface;
   procedure Dummy (Obj : I_Dummy) is abstract;

   type I_Writable is limited interface;
   procedure Write (Obj : I_Writable) is abstract;

   type I_Whole is limited interface and I_Dummy and I_Writable;
end;

with Small_Types; use Small_Types;
package Small_Tests is
   type T_Whole is new Small_Types.I_Whole with null record;
   procedure Dummy (Stream : T_Whole);
   procedure Write (Stream : T_Whole);

   procedure Run;
end;

with Ada.Text_IO; use Ada.Text_IO;
package body Small_Tests is
   procedure Write (Stream : T_Whole) is
   begin
      Put_Line ("OK");
   end;

   procedure Dummy (Stream : T_Whole) is
   begin
      Put_Line ("Wrong");
      raise Program_Error;
   end;

   procedure Test_1 (Obj : I_Writable'Class) is
   begin
      Obj.Write;  -- OK
   end;

   subtype T_Writable_Class is I_Writable'Class;

   procedure Test_2 (Obj : T_Writable_Class) is
   begin
      Obj.Write;  -- Wrong
   end;

   procedure Run is
      Obj : T_Whole;
   begin
      Put ("Test 1 .... "); Test_1 (Obj);
      Put ("Test 2 .... "); Test_2 (Obj);
   end;
end;

with Small_Tests;
procedure Small_Main is
begin
   Small_Tests.Run;
end;

Command: gnatmake small_main.adb; ./small_main
 Output:
Test 1 .... OK
Test 2 .... OK

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

2017-01-23  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Call): Improve the code that
	checks if some formal of the called subprogram is a class-wide
	interface, to handle subtypes of class-wide interfaces.

Attachment: difs
Description: Text document