From: Justin Squirek <squirek@adacore.com>
Date: Wed, 14 Nov 2018 11:41:46 +0000 (+0000)
Subject: [Ada] Crash on use of generic formal package
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=b7c34dff67750bf38d8b8d89ea44c01d8c7c5870;p=gcc.git

[Ada] Crash on use of generic formal package

This patch fixes an issue whereby a complicated set of generic formal
packages in conjunction with use_clauses may cause a crash during
visibility checking due to a homonym being out of scope during the
checking stage.

2018-11-14  Justin Squirek  <squirek@adacore.com>

gcc/ada/

	* sem_ch8.adb (Use_One_Package): Add test for out-of-scope
	homonyms.

gcc/testsuite/

	* gnat.dg/generic_pkg.adb: New testcase.

From-SVN: r266126
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 6be83416933..d4dcd8c41d6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-11-14  Justin Squirek  <squirek@adacore.com>
+
+	* sem_ch8.adb (Use_One_Package): Add test for out-of-scope
+	homonyms.
+
 2018-11-14  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch3.adb: (Expand_N_Object_Declaration): If the expression
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index fd0e444657f..a1bcbffea7f 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -9685,12 +9685,17 @@ package body Sem_Ch8 is
             --  current one would have been visible, so make the other one
             --  not use_visible.
 
+            --  In certain pathological cases it is possible that unrelated
+            --  homonyms from distinct formal packages may exist in an
+            --  uninstalled scope. We must test for that here.
+
             elsif Present (Current_Instance)
               and then Is_Potentially_Use_Visible (Prev)
               and then not Is_Overloadable (Prev)
               and then Scope (Id) /= Scope (Prev)
               and then Used_As_Generic_Actual (Scope (Prev))
               and then Used_As_Generic_Actual (Scope (Id))
+              and then Is_List_Member (Scope (Prev))
               and then not In_Same_List (Current_Use_Clause (Scope (Prev)),
                                          Current_Use_Clause (Scope (Id)))
             then
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6c45c142312..c4d7657d7d1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-11-14  Justin Squirek  <squirek@adacore.com>
+
+	* gnat.dg/generic_pkg.adb: New testcase.
+
 2018-11-14  Ed Schonberg  <schonberg@adacore.com>
 
 	* gnat.dg/limited_aggr.adb, gnat.dg/limited_aggr.ads: New
diff --git a/gcc/testsuite/gnat.dg/generic_pkg.adb b/gcc/testsuite/gnat.dg/generic_pkg.adb
new file mode 100644
index 00000000000..80f3e59252d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_pkg.adb
@@ -0,0 +1,37 @@
+--  { dg-do compile }
+
+procedure Generic_Pkg is
+   generic
+      type T_horizontal is new float;
+   package vectors_2D is end;
+
+   generic
+      with package C is new vectors_2d (<>);
+      with package D is new vectors_2d (<>);
+   package poshelp is end;
+
+   generic
+      with package Helper is new poshelp (<>);
+   package timevars is
+      use Helper.C;
+   end;
+
+   generic
+      with package C is new vectors_2d (<>);
+      with package D is new vectors_2d (<>);
+      with package Helper is new poshelp (C, D);
+   package Spagett is end;
+
+   generic
+      with package C is new vectors_2d (<>);
+      with package D is new vectors_2d (<>);
+      with package Helper is new poshelp (C, D);
+   package Touch is
+      use Helper;
+      package My_Spagett is new Spagett (C, D, Helper);
+      package timevars_Pkg is new timevars (Helper);
+   end;
+
+begin
+  null;
+end;