[Ada] Missing compile-time error in conversion of private type

[Arnaud Charlet <charlet at adacore dot com>]

The compiler does not reject a type conversion of an object of
of a private type that is derived from an interface type if the
target type of the conversion is one of the parents of the
full type declaration of the private type (which breaks the
privacy contract imposed by the private type). The following
test must compile with one error:

package Types_1 is
   type Iface is interface;

   type A_Root is tagged null record;
   type Typ1   is new A_Root and Iface with null record;

   type Typ1_Access is access all Typ1'Class;
end;

with Types_1; use Types_1;
package Types_2 is
   type Typ2 is new Iface with private;         -- [1]
   type Typ2_Access is access all Typ2'Class;
private
   type Typ2 is new Typ1 with null record;      -- [2]
end;

with Types_1; use Types_1;
with Types_2; use Types_2;
procedure Main is
   M   : Typ2_Access := new Typ2;
   Bug : Typ1_Access := Typ1_Access (M);  --  [3]: Error
begin
   null;
end Main;

At [1] the private type declaration of Typ2 does not provide information
Gindicating that its full view (at [2]) is a derivation of Typ1. Hence,
the type conversion (at [3]) must be rejected by the compiler.

Command: gcc -c -gnat05 main.adb
Output: invalid tagged conversion, not compatible with type "Typ2'Class"
        defined at types_2.ads:3

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

2011-08-02  Javier Miranda  <miranda@adacore.com>

	* sem_type.ads, sem_type.adb (Is_Ancestor): Addition of a new formal
	(Use_Full_View) which permits this routine to climb through the
	ancestors using the full-view of private parents.
	* sem_util.adb (Collect_Interfaces_Info, Implements_Interface): Set
	Use_Full_View to true in calls to Is_Ancestor.
	* sem_disp.adb (Override_Dispatching_Operation): Set Use_Full_View to
	true in call to Is_Ancestor.
	* exp_ch3.adb (Build_Offset_To_Top_Functions, Initialize_Tag): Set
	Use_Full_View to true in call to Is_Ancestor.
	* exp_ch7.adb (Controller_Component): Set Use_Full_View to true in
	call to Is_Ancestor.
	* exp_ch4.adb (Expand_N_Type_Conversion, Tagged_Membership): Set
	Use_Full_View to true in calls to Is_Ancestor.
	* exp_disp.adb (Expand_Interface_Actuals, Make_Secondary_DT, Make_DT,
	Make_Select_Specific_Data_Table, Register_Primitive,
	Set_All_DT_Position): Set Use_Full_View to true in calls to Is_Ancestor.
	* exp_intr.adb (Expand_Dispatching_Constructor_Call): Set Use_Full_View
	to true in call to Is_Ancestor.
	* exp_util.adb (Find_Interface_ADT, Find_Interface_Tag): Set
	Use_Full_View to true in calls to Is_Ancestor.
	* exp_cg.adb
	(Write_Call_Info): Set Use_Full_View to true in call to Is_Ancestor.
	(Write_Type_Info): Set Use_Full_View to true in call to Is_Ancestor.

Attachment: difs
Description: Text document