aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gcc/ada/ChangeLog5
-rw-r--r--gcc/ada/sem_disp.adb8
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/tagged2.adb9
-rw-r--r--gcc/testsuite/gnat.dg/tagged2.ads9
5 files changed, 35 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 1d6d8c0..e476413 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-04 Justin Squirek <squirek@adacore.com>
+
+ * sem_disp.adb (Check_Controlling_Formals): Obtain the full view
+ before type comparison.
+
2019-07-04 Ed Schonberg <schonberg@adacore.com>
* 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 a2f753b..92486cd 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 996a0ec..6873356 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-04 Justin Squirek <squirek@adacore.com>
+
+ * gnat.dg/tagged2.adb, gnat.dg/tagged2.ads: New testcase.
+
2019-07-04 Ed Schonberg <schonberg@adacore.com>
* 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 0000000..2cf9fc5
--- /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 0000000..8bbc485
--- /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;