From: Justin Squirek <squirek@adacore.com>
Date: Thu, 4 Jul 2019 08:06:40 +0000 (+0000)
Subject: [Ada] Spurious error on incomplete tagged formal parameter
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=e3a79ce3c18fc6e1df6176e506095c7f8bac30ab;p=gcc.git

[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  <squirek@adacore.com>

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
---

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  <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 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  <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 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;