[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 762db94..389a12d 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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)