The compiler skips adding an implicit type conversion when the interface
type is visible through a limited-with clause.
No small reproducer available.
Tested on x86_64-pc-linux-gnu, committed on trunk
2019-07-10 Javier Miranda <mira...@adacore.com>
gcc/ada/
* exp_ch6.adb (Is_Class_Wide_Interface_Type): New subprogram.
(Expand_Call_Helper): Handle non-limited views when we check if
any formal is a class-wide interface type.
* exp_disp.adb (Expand_Interface_Actuals): Handle non-limited
views when we look for interface type formals to force "this"
displacement.--- gcc/ada/exp_ch6.adb
+++ gcc/ada/exp_ch6.adb
@@ -2331,6 +2331,10 @@ package body Exp_Ch6 is
function In_Unfrozen_Instance (E : Entity_Id) return Boolean;
-- Return true if E comes from an instance that is not yet frozen
+ function Is_Class_Wide_Interface_Type (E : Entity_Id) return Boolean;
+ -- Return True when E is a class-wide interface type or an access to
+ -- a class-wide interface type.
+
function Is_Direct_Deep_Call (Subp : Entity_Id) return Boolean;
-- Determine if Subp denotes a non-dispatching call to a Deep routine
@@ -2585,6 +2589,32 @@ package body Exp_Ch6 is
return False;
end In_Unfrozen_Instance;
+ ----------------------------------
+ -- Is_Class_Wide_Interface_Type --
+ ----------------------------------
+
+ function Is_Class_Wide_Interface_Type (E : Entity_Id) return Boolean is
+ Typ : Entity_Id := E;
+ DDT : Entity_Id;
+
+ begin
+ if Has_Non_Limited_View (Typ) then
+ Typ := Non_Limited_View (Typ);
+ end if;
+
+ if Ekind (Typ) = E_Anonymous_Access_Type then
+ DDT := Directly_Designated_Type (Typ);
+
+ if Has_Non_Limited_View (DDT) then
+ DDT := Non_Limited_View (DDT);
+ end if;
+
+ return Is_Class_Wide_Type (DDT) and then Is_Interface (DDT);
+ else
+ return Is_Class_Wide_Type (Typ) and then Is_Interface (Typ);
+ end if;
+ end Is_Class_Wide_Interface_Type;
+
-------------------------
-- Is_Direct_Deep_Call --
-------------------------
@@ -2919,15 +2949,7 @@ package body Exp_Ch6 is
CW_Interface_Formals_Present :=
CW_Interface_Formals_Present
- or else
- (Is_Class_Wide_Type (Etype (Formal))
- and then Is_Interface (Etype (Etype (Formal))))
- or else
- (Ekind (Etype (Formal)) = E_Anonymous_Access_Type
- and then Is_Class_Wide_Type (Directly_Designated_Type
- (Etype (Etype (Formal))))
- and then Is_Interface (Directly_Designated_Type
- (Etype (Etype (Formal)))));
+ or else Is_Class_Wide_Interface_Type (Etype (Formal));
-- Create possible extra actual for constrained case. Usually, the
-- extra actual is of the form actual'constrained, but since this
--- gcc/ada/exp_disp.adb
+++ gcc/ada/exp_disp.adb
@@ -1682,18 +1682,34 @@ package body Exp_Disp is
while Present (Formal) loop
Formal_Typ := Etype (Formal);
+ if Has_Non_Limited_View (Formal_Typ) then
+ Formal_Typ := Non_Limited_View (Formal_Typ);
+ end if;
+
if Ekind (Formal_Typ) = E_Record_Type_With_Private then
Formal_Typ := Full_View (Formal_Typ);
end if;
if Is_Access_Type (Formal_Typ) then
Formal_DDT := Directly_Designated_Type (Formal_Typ);
+
+ if Has_Non_Limited_View (Formal_DDT) then
+ Formal_DDT := Non_Limited_View (Formal_DDT);
+ end if;
end if;
Actual_Typ := Etype (Actual);
+ if Has_Non_Limited_View (Actual_Typ) then
+ Actual_Typ := Non_Limited_View (Actual_Typ);
+ end if;
+
if Is_Access_Type (Actual_Typ) then
Actual_DDT := Directly_Designated_Type (Actual_Typ);
+
+ if Has_Non_Limited_View (Actual_DDT) then
+ Actual_DDT := Non_Limited_View (Actual_DDT);
+ end if;
end if;
if Is_Interface (Formal_Typ)
