From e3a79ce3c18fc6e1df6176e506095c7f8bac30ab Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Thu, 4 Jul 2019 08:06:40 +0000 Subject: [PATCH] [Ada] Spurious error on incomplete tagged formal parameter This patch fixes an issue whereby a check for competing controlling formals led to a spurious dispatching error due to an incomplete type being used within a subprogram specification. 2019-07-04 Justin Squirek gcc/ada/ * sem_disp.adb (Check_Controlling_Formals): Obtain the full view before type comparison. gcc/testsuite/ * gnat.dg/tagged2.adb, gnat.dg/tagged2.ads: New testcase. From-SVN: r273063 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_disp.adb | 8 ++++++++ gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/tagged2.adb | 9 +++++++++ gcc/testsuite/gnat.dg/tagged2.ads | 9 +++++++++ 5 files changed, 35 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/tagged2.adb create mode 100644 gcc/testsuite/gnat.dg/tagged2.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1d6d8c02109..e476413feb7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-07-04 Justin Squirek + + * sem_disp.adb (Check_Controlling_Formals): Obtain the full view + before type comparison. + 2019-07-04 Ed Schonberg * exp_ch4.ads, exp_ch4.adb (Build_Eq_Call): New visible diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index a2f753ba76e..92486cd2691 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -210,6 +210,14 @@ package body Sem_Disp is Ctrl_Type := Check_Controlling_Type (Etype (Formal), Subp); if Present (Ctrl_Type) then + -- Obtain the full type in case we are looking at an incomplete + -- view. + + if Ekind (Ctrl_Type) = E_Incomplete_Type + and then Present (Full_View (Ctrl_Type)) + then + Ctrl_Type := Full_View (Ctrl_Type); + end if; -- When controlling type is concurrent and declared within a -- generic or inside an instance use corresponding record type. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 996a0ece0c0..6873356c469 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-04 Justin Squirek + + * gnat.dg/tagged2.adb, gnat.dg/tagged2.ads: New testcase. + 2019-07-04 Ed Schonberg * gnat.dg/equal6.adb, gnat.dg/equal6_types.adb, diff --git a/gcc/testsuite/gnat.dg/tagged2.adb b/gcc/testsuite/gnat.dg/tagged2.adb new file mode 100644 index 00000000000..2cf9fc54aa6 --- /dev/null +++ b/gcc/testsuite/gnat.dg/tagged2.adb @@ -0,0 +1,9 @@ +-- { dg-do compile } + +package body Tagged2 is + + procedure Get_Parent + (DeviceX : Device; + Parent : out Device) is null; + +end Tagged2; diff --git a/gcc/testsuite/gnat.dg/tagged2.ads b/gcc/testsuite/gnat.dg/tagged2.ads new file mode 100644 index 00000000000..8bbc485c14b --- /dev/null +++ b/gcc/testsuite/gnat.dg/tagged2.ads @@ -0,0 +1,9 @@ +package Tagged2 is + type Device; + + procedure Get_Parent + (DeviceX : Device; + Parent : out Device); + + type Device is tagged null record; +end Tagged2; -- 2.30.2