Commit ecb2f4fe by Gary Dismukes Committed by Pierre-Marie de Rodat

[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
parent 6ab24ed7
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
......
......@@ -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);
......
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.
......
-- { dg-do compile }
with Generic_Inst7_Pkg;
procedure Generic_Inst7 is
package Inst is new Generic_Inst7_Pkg;
begin
null;
end Generic_Inst7;
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;
with Generic_Inst7_Types;
generic
package Generic_Inst7_Pkg is
procedure Process (List : in out Generic_Inst7_Types.List);
end Generic_Inst7_Pkg;
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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment