[Ada] Crash on protected type entry family

Message ID 20180611092300.GA134983@adacore.com
State New
Headers show
Series
  • [Ada] Crash on protected type entry family
Related show

Commit Message

Pierre-Marie de Rodat June 11, 2018, 9:23 a.m.
The compiler may blow up compiling the body of a protected type that has a
family entry whose entry index specification contains a call to a function.

Tested on x86_64-pc-linux-gnu, committed on trunk

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.

Patch

--- gcc/ada/exp_ch9.adb
+++ 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);

--- /dev/null
new file mode 100644
+++ 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;