[Ada] Spurious error passing access to class-wide interface type

The compiler reports an spurious error when the formal parameter of a
subprogram is an access to a class wide interface type and the actual
parameter is an allocator of an object covering such interface type.

2019-07-22  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* sem_res.adb (Resolve_Actuals): Replace code that displaces the
	pointer to an allocated object to reference its secondary
	dispatch table by a type conversion (which takes care of
	handling all cases).

gcc/testsuite/

	* gnat.dg/class_wide5.adb: New testcase.

From-SVN: r273690

gcc/ada/ChangeLog

+2019-07-22  Javier Miranda  <miranda@adacore.com>
+
+	* sem_res.adb (Resolve_Actuals): Replace code that displaces the
+	pointer to an allocated object to reference its secondary
+	dispatch table by a type conversion (which takes care of
+	handling all cases).
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* sprint.adb (Sprint_Node_Actual)

gcc/ada/sem_res.adb

@@ -4190,17 +4190,16 @@ package body Sem_Res is
                      DDT : constant Entity_Id :=
                              Directly_Designated_Type (Base_Type (Etype (F)));
 
-                     New_Itype : Entity_Id;
-
                   begin
+                     --  Displace the pointer to the object to reference its
+                     --  secondary dispatch table.
+
                      if Is_Class_Wide_Type (DDT)
                        and then Is_Interface (DDT)
                      then
-                        New_Itype := Create_Itype (E_Anonymous_Access_Type, A);
-                        Set_Etype (New_Itype, Etype (A));
-                        Set_Directly_Designated_Type
-                          (New_Itype, Directly_Designated_Type (Etype (A)));
-                        Set_Etype (A, New_Itype);
+                        Rewrite (A, Convert_To (Etype (F), Relocate_Node (A)));
+                        Analyze_And_Resolve (A, Etype (F),
+                          Suppress => Access_Check);
                      end if;
 
                      --  Ada 2005, AI-162:If the actual is an allocator, the

gcc/testsuite/ChangeLog

+2019-07-22  Javier Miranda  <miranda@adacore.com>
+
+	* gnat.dg/class_wide5.adb: New testcase.
+
 2019-07-22  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/opt80.adb: New testcase.

gcc/testsuite/gnat.dg/class_wide5.adb

+--  { dg-do compile }
+
+procedure Class_Wide5 is
+   type B is interface;
+   type B_Child is new B with null record;
+   type B_Ptr is access B'Class;
+
+   procedure P (Obj : B_Ptr) is begin null; end;
+begin
+   P (new B_child);  -- Test
+end Class_Wide5;