===================================================================
@@ -1198,14 +1198,14 @@
---------------------------
procedure Add_Call_By_Copy_Code is
+ Crep : Boolean;
Expr : Node_Id;
+ F_Typ : Entity_Id := Etype (Formal);
+ Indic : Node_Id;
Init : Node_Id;
Temp : Entity_Id;
- Indic : Node_Id;
+ V_Typ : Entity_Id;
Var : Entity_Id;
- F_Typ : constant Entity_Id := Etype (Formal);
- V_Typ : Entity_Id;
- Crep : Boolean;
begin
if not Is_Legal_Copy then
@@ -1214,6 +1214,14 @@
Temp := Make_Temporary (Loc, 'T', Actual);
+ -- Handle formals whose type comes from the limited view
+
+ if From_Limited_With (F_Typ)
+ and then Has_Non_Limited_View (F_Typ)
+ then
+ F_Typ := Non_Limited_View (F_Typ);
+ end if;
+
-- Use formal type for temp, unless formal type is an unconstrained
-- array, in which case we don't have to worry about bounds checks,
-- and we use the actual type, since that has appropriate bounds.
@@ -1221,7 +1229,7 @@
if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
Indic := New_Occurrence_Of (Etype (Actual), Loc);
else
- Indic := New_Occurrence_Of (Etype (Formal), Loc);
+ Indic := New_Occurrence_Of (F_Typ, Loc);
end if;
if Nkind (Actual) = N_Type_Conversion then
@@ -1473,20 +1481,28 @@
----------------------------------
procedure Add_Simple_Call_By_Copy_Code is
- Temp : Entity_Id;
Decl : Node_Id;
+ F_Typ : Entity_Id := Etype (Formal);
Incod : Node_Id;
+ Indic : Node_Id;
+ Lhs : Node_Id;
Outcod : Node_Id;
- Lhs : Node_Id;
Rhs : Node_Id;
- Indic : Node_Id;
- F_Typ : constant Entity_Id := Etype (Formal);
+ Temp : Entity_Id;
begin
if not Is_Legal_Copy then
return;
end if;
+ -- Handle formals whose type comes from the limited view
+
+ if From_Limited_With (F_Typ)
+ and then Has_Non_Limited_View (F_Typ)
+ then
+ F_Typ := Non_Limited_View (F_Typ);
+ end if;
+
-- Use formal type for temp, unless formal type is an unconstrained
-- array, in which case we don't have to worry about bounds checks,
-- and we use the actual type, since that has appropriate bounds.
@@ -1494,7 +1510,7 @@
if Is_Array_Type (F_Typ) and then not Is_Constrained (F_Typ) then
Indic := New_Occurrence_Of (Etype (Actual), Loc);
else
- Indic := New_Occurrence_Of (Etype (Formal), Loc);
+ Indic := New_Occurrence_Of (F_Typ, Loc);
end if;
-- Prepare to generate code
@@ -1517,7 +1533,7 @@
if Ekind (Formal) = E_Out_Parameter then
Incod := Empty;
- if Has_Discriminants (Etype (Formal)) then
+ if Has_Discriminants (F_Typ) then
Indic := New_Occurrence_Of (Etype (Actual), Loc);
end if;
@@ -1719,6 +1735,14 @@
E_Formal := Etype (Formal);
E_Actual := Etype (Actual);
+ -- Handle formals whose type comes from the limited view
+
+ if From_Limited_With (E_Formal)
+ and then Has_Non_Limited_View (E_Formal)
+ then
+ E_Formal := Non_Limited_View (E_Formal);
+ end if;
+
if Is_Scalar_Type (E_Formal)
or else Nkind (Actual) = N_Slice
then
The compiler silently skips generating the code to perform a type conversion when the all the following conditions occur: 1) the target type of the type conversion is an access to a class-wide interface type; 2) the type conversion is performed when passing an in-out access type actual to a subprogram; and 3) in the declaration of the called subprogram the type of that access to interface formal is visible through a limited-with clause. After this patch the following test compiles and executes well. package Types is type Iface is interface; type Ref_Iface is access all Iface'Class; procedure Enter (Self : in Iface) is abstract; type Parent is abstract tagged null record; type Object is new Parent and Iface with null record; type Ref_Object is access all Object'Class; not overriding procedure Some_Primitive (Self : in Object); overriding procedure Enter (Self : in Object); end; with GNAT.IO; package body Types is procedure Some_Primitive(Self : Object) is pragma Unreferenced (Self); begin GNAT.IO.Put_Line ("ERROR: wrong dispatching call"); end; procedure Enter(Self : in Object) is pragma Unreferenced (Self); begin GNAT.IO.Put("OK"); end; end; limited with Types; -- [3] package Do_Test is procedure Test (The_Bar : in out Types.Ref_Iface); -- [2] end; with Types; with GNAT.IO; use GNAT.IO; package body Do_Test is procedure Test (The_Bar : in out Types.Ref_Iface) is begin The_Bar.Enter; end; end; with Types; with Do_Test; procedure Main is The_Pub : Types.Ref_Object := new Types.Object; begin Do_Test.Test (Types.Ref_Iface(The_Pub)); -- [1] end; Command: gnatmake main.adb; ./main Output: OK Tested on x86_64-pc-linux-gnu, committed on trunk 2016-04-27 Javier Miranda <miranda@adacore.com> * exp_ch6.adb (Add_Call_By_Copy_Code, Add_Simple_Call_By_Copy_Code, Expand_Actuals): Handle formals whose type comes from the limited view.