[Ada] Hang on loop in generic with subtype indication specifying a range

The compiler may hang when a for loop expanded in a generic
instantiation has a range specified by a subtype indication with an
explicit range that has a bound that is an attribute applied to a
discriminant-dependent array component. The Parent field of the bound
may not be set, which can lead to endless looping when an actual subtype
created for the array component is passed to Insert_Actions. This is
fixed by setting the Parent fields of the copied bounds before
Preanalyze is called on them.

2019-08-12  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* sem_ch5.adb (Prepare_Param_Spec_Loop): Set the parents of the
	copied low and high bounds in the case where the loop range is
	given by a discrete_subtype_indication, to prevent hanging (or
	Assert_Failure) in Insert_Actions.

gcc/testsuite/

	* gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb,
	gnat.dg/generic_inst7_pkg.ads, gnat.dg/generic_inst7_types.ads:
	New testcase.

From-SVN: r274298

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3c22a90a21a5181e4c2e3480469f08450180dd83..1482a507897edf5795a6eb13beec24318839c6f9 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-08-12  Gary Dismukes  <dismukes@adacore.com>
+
+       * sem_ch5.adb (Prepare_Param_Spec_Loop): Set the parents of the
+       copied low and high bounds in the case where the loop range is
+       given by a discrete_subtype_indication, to prevent hanging (or
+       Assert_Failure) in Insert_Actions.
+
 2019-08-12  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch6.adb (heck_Untagged_Equality): Verify that user-defined

diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index ebe610b88e834a7352a5d273345605cb634c84f4..963819ede4a745067b45dabd202159c85e6104d9 100644 (file)
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -3636,11 +3636,16 @@ package body Sem_Ch5 is
             then
                Rng := Range_Expression (Constraint (Rng));
 
-               --  Preanalyze the bounds of the range constraint
+               --  Preanalyze the bounds of the range constraint, setting
+               --  parent fields to associate the copied bounds with the range,
+               --  allowing proper tree climbing during preanalysis.
 
                Low  := New_Copy_Tree (Low_Bound  (Rng));
                High := New_Copy_Tree (High_Bound (Rng));
 
+               Set_Parent (Low, Rng);
+               Set_Parent (High, Rng);
+
                Preanalyze (Low);
                Preanalyze (High);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ee519d4c21b42a3a80a991ca1810b36198440da9..f7f62763823bde61974c6e17fb1e9bd665a3a8c1 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2019-08-12  Gary Dismukes  <dismukes@adacore.com>
+
+       * gnat.dg/generic_inst7.adb, gnat.dg/generic_inst7_pkg.adb,
+       gnat.dg/generic_inst7_pkg.ads, gnat.dg/generic_inst7_types.ads:
+       New testcase.
+
 2019-08-12  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/equal10.adb, gnat.dg/equal10.ads: New testcase.

diff --git a/gcc/testsuite/gnat.dg/generic_inst7.adb b/gcc/testsuite/gnat.dg/generic_inst7.adb
new file mode 100644 (file)
index 0000000..d56e479
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst7.adb
@@ -0,0 +1,11 @@
+--  { dg-do compile }
+
+with Generic_Inst7_Pkg;
+
+procedure Generic_Inst7 is
+
+  package Inst is new Generic_Inst7_Pkg;
+
+begin
+   null;
+end Generic_Inst7;

diff --git a/gcc/testsuite/gnat.dg/generic_inst7_pkg.adb b/gcc/testsuite/gnat.dg/generic_inst7_pkg.adb
new file mode 100644 (file)
index 0000000..261ffea
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst7_pkg.adb
@@ -0,0 +1,12 @@
+package body Generic_Inst7_Pkg is
+
+   use type Generic_Inst7_Types.Index;
+
+   procedure Process (List : in out Generic_Inst7_Types.List) is
+   begin
+      for I in Generic_Inst7_Types.Index range 1 .. List.Arr'length loop
+         null;
+      end loop;
+   end Process;
+
+end Generic_Inst7_Pkg;

diff --git a/gcc/testsuite/gnat.dg/generic_inst7_pkg.ads b/gcc/testsuite/gnat.dg/generic_inst7_pkg.ads
new file mode 100644 (file)
index 0000000..7bc4abc
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst7_pkg.ads
@@ -0,0 +1,8 @@
+with Generic_Inst7_Types;
+
+generic
+package Generic_Inst7_Pkg is
+
+   procedure Process (List : in out Generic_Inst7_Types.List);
+
+end Generic_Inst7_Pkg;

diff --git a/gcc/testsuite/gnat.dg/generic_inst7_types.ads b/gcc/testsuite/gnat.dg/generic_inst7_types.ads
new file mode 100644 (file)
index 0000000..34d782d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/generic_inst7_types.ads
@@ -0,0 +1,15 @@
+package Generic_Inst7_Types is
+
+   type Index is new Integer range 0 .. 10;
+
+   type Element is record
+      I : Integer;
+   end record;
+
+   type Element_Array is array (Index range <>) of Element;
+
+   type List (Size : Index := 1) is record
+      Arr : Element_Array (1 .. Size);
+   end record;
+
+end Generic_Inst7_Types;