Commit 5a644684 by Javier Miranda Committed by Pierre-Marie de Rodat

[Ada] Missing implicit interface type conversion

The compiler skips adding an implicit type conversion when the interface
type is visible through a limited-with clause.

No small reproducer available.

2019-07-10  Javier Miranda  <miranda@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.

From-SVN: r273328
parent ff3ee5e5
2019-07-10 Javier Miranda <miranda@adacore.com>
* 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.
2019-07-10 Ed Schonberg <schonberg@adacore.com> 2019-07-10 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Equality_Op): Do not replace the resolved * sem_res.adb (Resolve_Equality_Op): Do not replace the resolved
......
...@@ -2331,6 +2331,10 @@ package body Exp_Ch6 is ...@@ -2331,6 +2331,10 @@ package body Exp_Ch6 is
function In_Unfrozen_Instance (E : Entity_Id) return Boolean; function In_Unfrozen_Instance (E : Entity_Id) return Boolean;
-- Return true if E comes from an instance that is not yet frozen -- 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; function Is_Direct_Deep_Call (Subp : Entity_Id) return Boolean;
-- Determine if Subp denotes a non-dispatching call to a Deep routine -- Determine if Subp denotes a non-dispatching call to a Deep routine
...@@ -2585,6 +2589,32 @@ package body Exp_Ch6 is ...@@ -2585,6 +2589,32 @@ package body Exp_Ch6 is
return False; return False;
end In_Unfrozen_Instance; 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 -- -- Is_Direct_Deep_Call --
------------------------- -------------------------
...@@ -2919,15 +2949,7 @@ package body Exp_Ch6 is ...@@ -2919,15 +2949,7 @@ package body Exp_Ch6 is
CW_Interface_Formals_Present := CW_Interface_Formals_Present :=
CW_Interface_Formals_Present CW_Interface_Formals_Present
or else or else Is_Class_Wide_Interface_Type (Etype (Formal));
(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)))));
-- Create possible extra actual for constrained case. Usually, the -- Create possible extra actual for constrained case. Usually, the
-- extra actual is of the form actual'constrained, but since this -- extra actual is of the form actual'constrained, but since this
......
...@@ -1682,18 +1682,34 @@ package body Exp_Disp is ...@@ -1682,18 +1682,34 @@ package body Exp_Disp is
while Present (Formal) loop while Present (Formal) loop
Formal_Typ := Etype (Formal); 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 if Ekind (Formal_Typ) = E_Record_Type_With_Private then
Formal_Typ := Full_View (Formal_Typ); Formal_Typ := Full_View (Formal_Typ);
end if; end if;
if Is_Access_Type (Formal_Typ) then if Is_Access_Type (Formal_Typ) then
Formal_DDT := Directly_Designated_Type (Formal_Typ); 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; end if;
Actual_Typ := Etype (Actual); 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 if Is_Access_Type (Actual_Typ) then
Actual_DDT := Directly_Designated_Type (Actual_Typ); 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; end if;
if Is_Interface (Formal_Typ) if Is_Interface (Formal_Typ)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment