Commit a3b7645b by Javier Miranda Committed by Pierre-Marie de Rodat

[Ada] Crash processing sources under GNATprove debug mode

Processing sources under -gnatd.F the frontend may crash on
an iterator of the form 'for X of ...' over an array if the
iterator is located in an inlined subprogram.

2018-07-16  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Code cleanup. Required
	to avoid generating an ill-formed tree that confuses gnatprove causing
	it to blowup.

gcc/testsuite/

	* gnat.dg/iter2.adb, gnat.dg/iter2.ads: New testcase.

From-SVN: r262707
parent c4ea2978
2018-07-16 Javier Miranda <miranda@adacore.com>
* exp_ch5.adb (Expand_Iterator_Loop_Over_Array): Code cleanup. Required
to avoid generating an ill-formed tree that confuses gnatprove causing
it to blowup.
2018-07-16 Yannick Moy <moy@adacore.com> 2018-07-16 Yannick Moy <moy@adacore.com>
* inline.adb (Has_Single_Return): Rewrap comment. * inline.adb (Has_Single_Return): Rewrap comment.
......
...@@ -3711,9 +3711,14 @@ package body Exp_Ch5 is ...@@ -3711,9 +3711,14 @@ package body Exp_Ch5 is
Ind_Comp := Ind_Comp :=
Make_Indexed_Component (Loc, Make_Indexed_Component (Loc,
Prefix => Relocate_Node (Array_Node), Prefix => New_Copy_Tree (Array_Node),
Expressions => New_List (New_Occurrence_Of (Iterator, Loc))); Expressions => New_List (New_Occurrence_Of (Iterator, Loc)));
-- Propagate the original node to the copy since the analysis of the
-- following object renaming declaration relies on the original node.
Set_Original_Node (Prefix (Ind_Comp), Original_Node (Array_Node));
Prepend_To (Stats, Prepend_To (Stats,
Make_Object_Renaming_Declaration (Loc, Make_Object_Renaming_Declaration (Loc,
Defining_Identifier => Id, Defining_Identifier => Id,
...@@ -3755,7 +3760,7 @@ package body Exp_Ch5 is ...@@ -3755,7 +3760,7 @@ package body Exp_Ch5 is
Defining_Identifier => Iterator, Defining_Identifier => Iterator,
Discrete_Subtype_Definition => Discrete_Subtype_Definition =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Array_Node), Prefix => New_Copy_Tree (Array_Node),
Attribute_Name => Name_Range, Attribute_Name => Name_Range,
Expressions => New_List ( Expressions => New_List (
Make_Integer_Literal (Loc, Dim1))), Make_Integer_Literal (Loc, Dim1))),
...@@ -3792,7 +3797,7 @@ package body Exp_Ch5 is ...@@ -3792,7 +3797,7 @@ package body Exp_Ch5 is
Defining_Identifier => Iterator, Defining_Identifier => Iterator,
Discrete_Subtype_Definition => Discrete_Subtype_Definition =>
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Relocate_Node (Array_Node), Prefix => New_Copy_Tree (Array_Node),
Attribute_Name => Name_Range, Attribute_Name => Name_Range,
Expressions => New_List ( Expressions => New_List (
Make_Integer_Literal (Loc, Dim1))), Make_Integer_Literal (Loc, Dim1))),
......
2018-07-16 Javier Miranda <miranda@adacore.com>
* gnat.dg/iter2.adb, gnat.dg/iter2.ads: New testcase.
2018-07-16 Richard Biener <rguenther@suse.de> 2018-07-16 Richard Biener <rguenther@suse.de>
PR lto/86523 PR lto/86523
......
-- { dg-do compile }
-- { dg-options "-gnatd.F -gnatws" }
package body Iter2
with SPARK_Mode
is
function To_String (Name : String) return String
is
procedure Append (Result : in out String;
Data : String)
with Inline_Always;
procedure Append (Result : in out String;
Data : String)
is
begin
for C of Data
loop
Result (1) := C;
end loop;
end Append;
Result : String (1 .. 3);
begin
Append (Result, "</" & Name & ">");
return Result;
end To_String;
end Iter2;
package Iter2
with SPARK_Mode
is
function To_String (Name : String) return String;
end Iter2;
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