From 09adaa8d122955d9661b01d2fe005975e1331f46 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Mon, 11 Jun 2018 09:18:33 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch9.adb | 7 +++++-- gcc/testsuite/ChangeLog | 4 ++++ gcc/testsuite/gnat.dg/prot4.adb | 28 ++++++++++++++++++++++++++++ 4 files changed, 42 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/prot4.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3314303f62c..cafac4fcf2a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2018-06-11 Javier Miranda + + * exp_ch9.adb (Expand_N_Protected_Body): Add missing handling of + N_Call_Marker nodes. + 2018-06-11 Arnaud Charlet * exp_ch3.adb, exp_unst.adb, inline.adb, sem_prag.adb: Minor diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 981c0ee7e1f..7cb5068f12b 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -8653,8 +8653,11 @@ package body Exp_Ch9 is when N_Implicit_Label_Declaration => null; - when N_Itype_Reference => - Insert_After (Current_Node, New_Copy (Op_Body)); + when N_Call_Marker | + 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 => New_Op_Body := New_Copy (Op_Body); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 7e8948e3151..e9a5c15aafd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-06-11 Javier Miranda + + * gnat.dg/prot4.adb: New testcase. + 2018-06-11 Yannick Moy * gnat.dg/part_of1-instantiation.adb, diff --git a/gcc/testsuite/gnat.dg/prot4.adb b/gcc/testsuite/gnat.dg/prot4.adb new file mode 100644 index 00000000000..ca51ff2fa7a --- /dev/null +++ b/gcc/testsuite/gnat.dg/prot4.adb @@ -0,0 +1,28 @@ +-- { 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; -- 2.30.2