Commit 09adaa8d by Javier Miranda Committed by Pierre-Marie de Rodat

[Ada] Crash on protected type entry family

The compiler may blow up compiling a the body of a protected type that has a
family entry whose entry index specification contains a call to a function.

2018-06-11  Javier Miranda  <miranda@adacore.com>

gcc/ada/

	* exp_ch9.adb (Expand_N_Protected_Body): Add missing handling of
	N_Call_Marker nodes.

gcc/testsuite/

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

From-SVN: r261417
parent 3e6845df
2018-06-11 Javier Miranda <miranda@adacore.com>
* exp_ch9.adb (Expand_N_Protected_Body): Add missing handling of
N_Call_Marker nodes.
2018-06-11 Arnaud Charlet <charlet@adacore.com> 2018-06-11 Arnaud Charlet <charlet@adacore.com>
* exp_ch3.adb, exp_unst.adb, inline.adb, sem_prag.adb: Minor * exp_ch3.adb, exp_unst.adb, inline.adb, sem_prag.adb: Minor
......
...@@ -8653,8 +8653,11 @@ package body Exp_Ch9 is ...@@ -8653,8 +8653,11 @@ package body Exp_Ch9 is
when N_Implicit_Label_Declaration => when N_Implicit_Label_Declaration =>
null; null;
when N_Itype_Reference => when N_Call_Marker |
Insert_After (Current_Node, New_Copy (Op_Body)); N_Itype_Reference =>
New_Op_Body := New_Copy (Op_Body);
Insert_After (Current_Node, New_Op_Body);
Current_Node := New_Op_Body;
when N_Freeze_Entity => when N_Freeze_Entity =>
New_Op_Body := New_Copy (Op_Body); New_Op_Body := New_Copy (Op_Body);
......
2018-06-11 Javier Miranda <miranda@adacore.com>
* gnat.dg/prot4.adb: New testcase.
2018-06-11 Yannick Moy <moy@adacore.com> 2018-06-11 Yannick Moy <moy@adacore.com>
* gnat.dg/part_of1-instantiation.adb, * gnat.dg/part_of1-instantiation.adb,
......
-- { dg-do compile }
procedure Prot4 is
type App_Priority is (Low, Medium, High);
function Alpha return App_Priority is
begin
return Low;
end Alpha;
function Beta return App_Priority is
begin
return High;
end Beta;
protected Hold is
entry D7 (App_Priority range Alpha .. Beta);
end Hold;
protected body Hold is
entry D7 (for AP in App_Priority range Alpha .. Beta) when True is
begin
null;
end D7;
end Hold;
begin
null;
end;
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