[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4b817ce93288352b35eb8beb38c5a023f49cc1f0..4711b6d3dd97c296136962427f5bf623982cb60f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+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)

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index fd4fedc303273cc949d9fd451ea5166454ffac3a..b668a5102bb6792e0c656457460938b571f92d3d 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/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

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index acc60635027d682043429d25bf6e0d946c6a620e..2ac298f87cede6dbd93cdc22bfcf814360904b1d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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.

diff --git a/gcc/testsuite/gnat.dg/class_wide5.adb b/gcc/testsuite/gnat.dg/class_wide5.adb
new file mode 100644 (file)
index 0000000..008273f
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/class_wide5.adb
@@ -0,0 +1,11 @@
+--  { 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;