[Ada] Wrong derivation of interfaces in generic formals

[Arnaud Charlet <charlet at adacore dot com>]

This patch improves the derivation of generic formals that are types
that cover interfaces. Previous support required only name consistency;
the new implementation is more complete because types of arguments
are also checked. The following test now compiles silently.

generic
package Gen is
   type Root is abstract tagged null record;
   type Rec  is record null; end record;

   type Iface is interface;
   procedure Prim1 (Obj : Iface; R : Rec) is abstract;
   procedure Prim2 (Obj : Iface; R : Rec) is abstract;

   type Iface2 is interface;
   procedure Prim1 (Obj : Iface2; R : Rec; V : Natural) is abstract;

   type Iface3 is interface and Iface;

   type DT2 is new Root and Iface2 and Iface3 with null record;
   procedure Prim1 (Obj : DT2; R : Rec; V : Natural);
   procedure Prim2 (Obj : DT2; R : Rec);
   procedure Prim1 (Obj : DT2; R : Rec);
end;

with Gen;
generic
   with package Formal_Pkg is new Gen;
   type Formal_Type is new Formal_Pkg.Root and Formal_Pkg.Iface with private;
package Test_Matching_Formals is
   procedure Do_Test;
end;

package body Test_Matching_Formals is
   procedure Do_Test is
      Obj1 : Formal_Pkg.DT2;
      Obj2 : Formal_Type;
      Rec  : Formal_Pkg.Rec;
   begin
      Formal_Pkg.Iface'Class (Obj1).Prim1 (Rec);
      Formal_Pkg.Iface'Class (Obj2).Prim1 (Rec);
   end;
end;

with Gen;
with Test_Matching_Formals;
package Main_Pkg is
   package Root_Inst is new Gen;
   package Test_Pkg  is new Test_Matching_Formals (
     Formal_Pkg   => Root_Inst,
     Formal_Type  => Root_Inst.DT2);
   procedure Do_Test;
end;

package body Main_Pkg is
   procedure Do_Test is
      Obj : Root_Inst.DT2;
      Rec : Root_Inst.Rec;
   begin
      Root_Inst.Iface'Class (Obj).Prim1 (Rec);
   end;
end;

package body Gen is
   procedure Prim1 (Obj : DT2; R : Rec; V : Natural) is
   begin
     raise Program_Error;
   end;
   procedure Prim2 (Obj : DT2; R : Rec) is begin null; end;
   procedure Prim1 (Obj : DT2; R : Rec) is begin null; end;
end;

with Main_Pkg; use Main_Pkg;
procedure Test_Iface_Formals is
begin
   Do_Test;
   Test_Pkg.Do_Test;
end Main;

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

2010-06-23  Javier Miranda  <miranda@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): Generate internal
	entities for parent types that are interfaces. Needed in generics to
	handle formals that implement interfaces.
	(Derive_Subprograms): Add assertion for derivation of tagged types that
	do not cover interfaces. For generics, complete code that handles
	derivation of type that covers interfaces because the previous
	condition was weak (it required only name consistency; arguments were
	not checked). Add new code to locate primitives covering interfaces
	defined in generic units or instantiatons.
	* sem_util.adb (Has_Interfaces): Add missing support for derived types.
	* sem_ch6.adb (Check_Overriding_Indicator): Minor code cleanups.
	* exp_disp.adb (Make_Select_Specific_Data_Table): Skip primitives of
	interfaces that are parents of the type because they share the primary
	dispatch table.
	(Register_Primitive): Do not register primitives of interfaces that
	are parents of the type.
	* sem_ch13.adb (Analyze_Freeze_Entity): Add documentation.
	* exp_cg.adb (Write_Type_Info): When displaying overriding of interface
	primitives skip primitives of interfaces that are parents of the type.

Attachment: difs
Description: Text document