aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorJavier Miranda <miranda@adacore.com>2019-07-10 09:00:16 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-10 09:00:16 +0000
commit5a6446841aa17a717f2f04ec22e507c86c864355 (patch)
treee3c003cef5af854fca79a551e074c3d23ab52dfe /gcc
parentff3ee5e5ef8c91d94a0ff6236a46dc46a670f1c3 (diff)
downloadgcc-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/ChangeLog9
-rw-r--r--gcc/ada/exp_ch6.adb40
-rw-r--r--gcc/ada/exp_disp.adb16
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)