[Ada] Crash on instantiation of nested generic in private part

[Ada] Crash on instantiation of nested generic in private part

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 849 bytes --]

This patch fixes a compiler abort on an instantiation of a generic nested
within another instance, when the outer instance is declared in the visible
part of a package and the inner intance is in the private part of the same
package.

Tested on x86_64-pc-linux-gnu, committed on trunk

2018-06-11  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* sem_ch12.adb (Install_Body): In order to determine the placement of
	the freeze node for an instance of a generic nested within another
	instance, take into account that the outer instance may be declared in
	the visible part of a package and the inner intance may be in the
	private part of the same package.

gcc/testsuite/

	* gnat.dg/nested_generic2.adb, gnat.dg/nested_generic2.ads,
	gnat.dg/nested_generic2_g1.adb, gnat.dg/nested_generic2_g1.ads,
	gnat.dg/nested_generic2_g2.ads: New testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 2633 bytes --]

--- gcc/ada/sem_ch12.adb
+++ gcc/ada/sem_ch12.adb
@@ -9527,9 +9527,13 @@ package body Sem_Ch12 is
                --  the freeze node for Inst must be inserted after that of
                --  Parent_Inst. This relation is established by comparing
                --  the Slocs of Parent_Inst freeze node and Inst.
+               --  We examine the parents of the enclosing lists to handle
+               --  the case where the parent instance is in the visible part
+               --  of a package declaration, and the inner instance is in
+               --  the corresponding private part.
 
-               if List_Containing (Get_Unit_Instantiation_Node (Par)) =
-                  List_Containing (N)
+               if Parent (List_Containing (Get_Unit_Instantiation_Node (Par)))
+                  = Parent (List_Containing (N))
                  and then Sloc (Freeze_Node (Par)) < Sloc (N)
                then
                   Insert_Freeze_Node_For_Instance (N, F_Node);

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/nested_generic2.adb
@@ -0,0 +1,5 @@
+--  { dg-do compile }
+
+package body Nested_Generic2 is
+   procedure Dummy is null;
+end Nested_Generic2;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/nested_generic2.ads
@@ -0,0 +1,13 @@
+with Nested_Generic2_G1;
+with Nested_Generic2_G2;
+
+package Nested_Generic2 is
+
+   package My_G1 is new Nested_Generic2_G1 ("Lewis");
+   package My_G2 is new Nested_Generic2_G2 (T => Integer, P => My_G1);
+
+   procedure Dummy;
+
+private
+   package My_Nested is new My_G1.Nested ("Clark");
+end Nested_Generic2;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/nested_generic2_g1.adb
@@ -0,0 +1,15 @@
+package body Nested_Generic2_G1 is
+
+   procedure Debug (Msg : String; Prefix : String) is
+   begin
+      null;
+   end;
+
+   package body Nested is
+      procedure Debug (Msg : String) is
+      begin
+         Debug (Msg, Prefix);
+      end;
+   end Nested;
+
+end Nested_Generic2_G1;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/nested_generic2_g1.ads
@@ -0,0 +1,13 @@
+generic
+   S : String;
+package Nested_Generic2_G1 is
+
+   procedure Debug (Msg : String; Prefix : String);
+
+   generic
+      Prefix : String;
+   package Nested is
+      procedure Debug (Msg : String);
+   end Nested;
+
+end Nested_Generic2_G1;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/nested_generic2_g2.ads
@@ -0,0 +1,7 @@
+with Nested_Generic2_G1;
+
+generic
+  type T is private;
+  with package P is new Nested_Generic2_G1 (<>);
+package Nested_Generic2_G2 is
+end Nested_Generic2_G2;