Commit 682c09ce by Bob Duff Committed by Pierre-Marie de Rodat

[Ada] Infinite loop with concatenation and aspect

This patch fixes a bug where an array object initialized with a
concatenation, and that has an aspect_specification for Alignment,
causes the compiler goes into an infinite loop.

2019-09-19  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch3.adb (Rewrite_As_Renaming): Return False if there are
	any aspect specifications, because otherwise Insert_Actions
	blows up.

gcc/testsuite/

	* gnat.dg/concat3.adb: New testcase.

From-SVN: r275934
parent 348c3ae6
2019-09-19 Bob Duff <duff@adacore.com>
* exp_ch3.adb (Rewrite_As_Renaming): Return False if there are
any aspect specifications, because otherwise Insert_Actions
blows up.
2019-09-19 Eric Botcazou <ebotcazou@adacore.com> 2019-09-19 Eric Botcazou <ebotcazou@adacore.com>
* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Add * exp_ch6.adb (Add_Simple_Call_By_Copy_Code): Add
......
...@@ -6318,7 +6318,8 @@ package body Exp_Ch3 is ...@@ -6318,7 +6318,8 @@ package body Exp_Ch3 is
------------------------- -------------------------
function Rewrite_As_Renaming return Boolean is function Rewrite_As_Renaming return Boolean is
begin Result : constant Boolean :=
-- If the object declaration appears in the form -- If the object declaration appears in the form
-- Obj : Ctrl_Typ := Func (...); -- Obj : Ctrl_Typ := Func (...);
...@@ -6336,12 +6337,12 @@ package body Exp_Ch3 is ...@@ -6336,12 +6337,12 @@ package body Exp_Ch3 is
-- This part is disabled for now, because it breaks GPS builds -- This part is disabled for now, because it breaks GPS builds
return (False -- ??? (False -- ???
and then Nkind (Expr_Q) = N_Explicit_Dereference and then Nkind (Expr_Q) = N_Explicit_Dereference
and then not Comes_From_Source (Expr_Q) and then not Comes_From_Source (Expr_Q)
and then Nkind (Original_Node (Expr_Q)) = N_Function_Call and then Nkind (Original_Node (Expr_Q)) = N_Function_Call
and then Nkind (Object_Definition (N)) in N_Has_Entity and then Nkind (Object_Definition (N)) in N_Has_Entity
and then (Needs_Finalization (Entity (Object_Definition (N))))) and then (Needs_Finalization (Entity (Object_Definition (N)))))
-- If the initializing expression is for a variable with attribute -- If the initializing expression is for a variable with attribute
-- OK_To_Rename set, then transform: -- OK_To_Rename set, then transform:
...@@ -6362,6 +6363,14 @@ package body Exp_Ch3 is ...@@ -6362,6 +6363,14 @@ package body Exp_Ch3 is
and then Ekind (Entity (Expr_Q)) = E_Variable and then Ekind (Entity (Expr_Q)) = E_Variable
and then OK_To_Rename (Entity (Expr_Q)) and then OK_To_Rename (Entity (Expr_Q))
and then Is_Entity_Name (Obj_Def)); and then Is_Entity_Name (Obj_Def));
begin
-- Return False if there are any aspect specifications, because
-- otherwise we duplicate that corresponding implicit attribute
-- definition, and call Insert_Action, which has no place to insert
-- the attribute definition. The attribute definition is stored in
-- Aspect_Rep_Item, which is not a list.
return Result and then No (Aspect_Specifications (N));
end Rewrite_As_Renaming; end Rewrite_As_Renaming;
-- Local variables -- Local variables
......
2019-09-19 Bob Duff <duff@adacore.com>
* gnat.dg/concat3.adb: New testcase.
2019-09-19 Eric Botcazou <ebotcazou@adacore.com> 2019-09-19 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/pack26.adb: New testcase. * gnat.dg/pack26.adb: New testcase.
......
-- { dg-do run }
-- { dg-options "-g -O0 -gnata" }
procedure Concat3 is
procedure Show_Bug (S : in String)
is
Str : constant String := S & "-" with Alignment => 4;
begin
null;
end Show_Bug;
begin
Show_Bug ("BUG");
end Concat3;
\ No newline at end of file
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