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

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.

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.

From-SVN: r261398

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 32724994207a4b33927964ecf1a608cfcecdccaf..a2620cfabb2afccbf0dacc3d638ff89c709f5ac6 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2018-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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.
+
 2018-06-11  Eric Botcazou  <ebotcazou@adacore.com>
 
        * errout.adb (Special_Msg_Delete): Remove handling of Atomic and VFA.

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 93a1c12053d721d858c8b3c4a27b7f1b355df75c..5cc30154abc329f0bd699281fcedd0b3bc5a0e69 100644 (file)
--- a/gcc/ada/sem_ch12.adb
+++ b/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);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 040cce2b770bec0377702af84266f3d7519826b0..579cc617c4d89ca2c2d516b969bc7c982a14e4c0 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2018-06-11  Ed Schonberg  <schonberg@adacore.com>
+
+       * 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.
+
 2018-06-10  Paolo Carlini  <paolo.carlini@oracle.com>
 
        * g++.dg/template/friend64.C: New.

diff --git a/gcc/testsuite/gnat.dg/nested_generic2.adb b/gcc/testsuite/gnat.dg/nested_generic2.adb
new file mode 100644 (file)
index 0000000..b454254
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/nested_generic2.ads b/gcc/testsuite/gnat.dg/nested_generic2.ads
new file mode 100644 (file)
index 0000000..6cf2a41
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/nested_generic2_g1.adb b/gcc/testsuite/gnat.dg/nested_generic2_g1.adb
new file mode 100644 (file)
index 0000000..446b495
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/nested_generic2_g1.ads b/gcc/testsuite/gnat.dg/nested_generic2_g1.ads
new file mode 100644 (file)
index 0000000..a7a48d6
--- /dev/null
+++ b/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;

diff --git a/gcc/testsuite/gnat.dg/nested_generic2_g2.ads b/gcc/testsuite/gnat.dg/nested_generic2_g2.ads
new file mode 100644 (file)
index 0000000..2b02167
--- /dev/null
+++ b/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;