[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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3314303..cafac4f 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+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>
 
        * 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 981c0ee..7cb5068 100644 (file)
--- 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 7e8948e..e9a5c15 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2018-06-11  Javier Miranda  <miranda@adacore.com>
+
+       * gnat.dg/prot4.adb: New testcase.
+
 2018-06-11  Yannick Moy  <moy@adacore.com>
 
        * 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 (file)
index 0000000..ca51ff2
--- /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;