This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Spurious error passing access to class-wide interface type
- From: Pierre-Marie de Rodat <derodat at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Cc: Javier Miranda <miranda at adacore dot com>
- Date: Mon, 22 Jul 2019 10:02:18 -0400
- Subject: [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.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
--- gcc/ada/sem_res.adb
+++ 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
--- /dev/null
new file mode 100644
+++ 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;