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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-11-14 Justin Squirek <squi...@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.
--- gcc/ada/sem_ch8.adb
+++ 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
--- /dev/null
new file mode 100644
+++ 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;