diff options
author | Javier Miranda <miranda@adacore.com> | 2019-07-10 09:00:16 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-10 09:00:16 +0000 |
commit | 5a6446841aa17a717f2f04ec22e507c86c864355 (patch) | |
tree | e3c003cef5af854fca79a551e074c3d23ab52dfe /gcc | |
parent | ff3ee5e5ef8c91d94a0ff6236a46dc46a670f1c3 (diff) | |
download | gcc-5a6446841aa17a717f2f04ec22e507c86c864355.zip gcc-5a6446841aa17a717f2f04ec22e507c86c864355.tar.gz gcc-5a6446841aa17a717f2f04ec22e507c86c864355.tar.bz2 |
[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
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 40 | ||||
-rw-r--r-- | gcc/ada/exp_disp.adb | 16 |
3 files changed, 56 insertions, 9 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 762db94..389a12d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +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> * sem_res.adb (Resolve_Equality_Op): Do not replace the resolved diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 364acd9..448f981 100644 --- a/gcc/ada/exp_ch6.adb +++ b/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 diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index a659594..4fae37c 100644 --- a/gcc/ada/exp_disp.adb +++ b/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) |