diff options
| author | Javier Miranda <miranda@adacore.com> | 2019-07-22 13:58:09 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-22 13:58:09 +0000 |
| commit | 137dabdd82648ccd5f0adedea2fbb8504f6c7485 (patch) | |
| tree | c887c30fcdaabe5e2a8c2dee4cc5a8f7bd1c647f | |
| parent | 2f8313ce5a14700907822a4f8c0dc18649276136 (diff) | |
| download | gcc-137dabdd82648ccd5f0adedea2fbb8504f6c7485.zip gcc-137dabdd82648ccd5f0adedea2fbb8504f6c7485.tar.gz gcc-137dabdd82648ccd5f0adedea2fbb8504f6c7485.tar.bz2 | |
[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
| -rw-r--r-- | gcc/ada/ChangeLog | 7 | ||||
| -rw-r--r-- | gcc/ada/sem_res.adb | 13 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/class_wide5.adb | 11 |
4 files changed, 28 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4b817ce..4711b6d 100644 --- 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 fd4fedc..b668a51 100644 --- 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 acc6063..2ac298f 100644 --- 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 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; |