[Ada] Crash on protected type with self-referential component

Message ID 20190711080345.GA95245@adacore.com
State New
Headers show
Series
  • [Ada] Crash on protected type with self-referential component
Related show

Commit Message

Pierre-Marie de Rodat July 11, 2019, 8:03 a.m.
This patch fixes a compiler abort on a declarastion for a protected type
PT when one of its private component is of type access PT.

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

2019-07-11  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_ch9.adb (Expand_N_Protected_Type_Declaaration): New
	subsidiary routine Replace_Access_Definition, to handle properly
	a protected type PT one of whose private components is of type
	access PT.

gcc/testsuite/

	* gnat.dg/prot8.adb, gnat.dg/prot8.ads: New testcase.

Patch

--- gcc/ada/exp_ch9.adb
+++ gcc/ada/exp_ch9.adb
@@ -8928,6 +8928,8 @@  package body Exp_Ch9 is
       Current_Node : Node_Id := N;
       E_Count      : Int;
       Entries_Aggr : Node_Id;
+      Rec_Decl     : Node_Id;
+      Rec_Id       : Entity_Id;
 
       procedure Check_Inlining (Subp : Entity_Id);
       --  If the original operation has a pragma Inline, propagate the flag
@@ -8949,6 +8951,21 @@  package body Exp_Ch9 is
       --  For a protected operation that is an interrupt handler, add the
       --  freeze action that will register it as such.
 
+      procedure Replace_Access_Definition (Comp : Node_Id);
+      --  If a private component of the type is an access to itself, this
+      --  is not a reference to the current instance, but an access type out
+      --  of which one might construct a list. If such a component exists, we
+      --  create an incomplete type for the equivalent record type, and
+      --  a named access type for it, that replaces the access definition
+      --  of the original component. This is similar to what is done for
+      --  records in Check_Anonymous_Access_Components, but simpler, because
+      --  the corresponding record type has no previous declaration.
+      --  This needs to be done only once, even if there are several such
+      --  access components. The following entity stores the constructed
+      --  access type.
+
+      Acc_T : Entity_Id := Empty;
+
       --------------------
       -- Check_Inlining --
       --------------------
@@ -9096,6 +9113,41 @@  package body Exp_Ch9 is
          Append_Freeze_Action (Prot_Proc, RTS_Call);
       end Register_Handler;
 
+      -------------------------------
+      -- Replace_Access_Definition --
+      -------------------------------
+
+      procedure Replace_Access_Definition (Comp : Node_Id) is
+         Loc     : constant Source_Ptr := Sloc (Comp);
+         Inc_T   : Node_Id;
+         Inc_D   : Node_Id;
+         Acc_Def : Node_Id;
+         Acc_D   : Node_Id;
+
+      begin
+         if No (Acc_T) then
+            Inc_T   := Make_Defining_Identifier (Loc, Chars (Rec_Id));
+            Inc_D   := Make_Incomplete_Type_Declaration (Loc, Inc_T);
+            Acc_T   := Make_Temporary (Loc, 'S');
+            Acc_Def :=
+              Make_Access_To_Object_Definition (Loc,
+                Subtype_Indication => New_Occurrence_Of (Inc_T, Loc));
+            Acc_D :=
+              Make_Full_Type_Declaration (Loc,
+                Defining_Identifier => Acc_T,
+                Type_Definition => Acc_Def);
+
+            Insert_Before (Rec_Decl, Inc_D);
+            Analyze (Inc_D);
+
+            Insert_Before (Rec_Decl, Acc_D);
+            Analyze (Acc_D);
+         end if;
+
+         Set_Access_Definition (Comp, Empty);
+         Set_Subtype_Indication (Comp, New_Occurrence_Of (Acc_T, Loc));
+      end Replace_Access_Definition;
+
       --  Local variables
 
       Body_Arr    : Node_Id;
@@ -9107,7 +9159,6 @@  package body Exp_Ch9 is
       Obj_Def     : Node_Id;
       Object_Comp : Node_Id;
       Priv        : Node_Id;
-      Rec_Decl    : Node_Id;
       Sub         : Node_Id;
 
    --  Start of processing for Expand_N_Protected_Type_Declaration
@@ -9117,6 +9168,7 @@  package body Exp_Ch9 is
          return;
       else
          Rec_Decl := Build_Corresponding_Record (N, Prot_Typ, Loc);
+         Rec_Id   := Defining_Identifier (Rec_Decl);
       end if;
 
       Cdecls := Component_Items (Component_List (Type_Definition (Rec_Decl)));
@@ -9262,6 +9314,15 @@  package body Exp_Ch9 is
                          Access_Definition  =>
                            New_Copy_Tree
                              (Access_Definition (Old_Comp), Discr_Map));
+
+                      --  A self-reference in the private part becomes a
+                      --  self-reference to the corresponding record.
+
+                     if Entity (Subtype_Mark (Access_Definition (New_Comp)))
+                       = Prot_Typ
+                     then
+                        Replace_Access_Definition (New_Comp);
+                     end if;
                   end if;
 
                   New_Priv :=

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot8.adb
@@ -0,0 +1,8 @@ 
+--  { dg-do compile }
+
+package body Prot8 is
+
+  protected body Prot is
+  end Prot;
+
+end Prot8;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/prot8.ads
@@ -0,0 +1,10 @@ 
+package Prot8 is
+
+  protected type Prot is
+  private
+    B : Boolean;
+    N : access Prot;
+    Ptr : access Prot;
+  end Prot;
+
+end Prot8;