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 <mira...@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.
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 235493)
+++ exp_ch6.adb (working copy)
@@ -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
