From a13a714e710f13b6fa6f88481a3c94b7d2dbc8cf Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 11 Jul 2019 08:02:53 +0000 Subject: [PATCH] [Ada] Crash on protected type with self-referential component 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. 2019-07-11 Ed Schonberg 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. From-SVN: r273399 --- gcc/ada/ChangeLog | 7 ++++ gcc/ada/exp_ch9.adb | 63 ++++++++++++++++++++++++++++++++- gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/prot8.adb | 8 +++++ gcc/testsuite/gnat.dg/prot8.ads | 10 ++++++ 5 files changed, 91 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/prot8.adb create mode 100644 gcc/testsuite/gnat.dg/prot8.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3b04ce8463f..dbe11d8f46e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-11 Ed Schonberg + + * 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. + 2019-07-11 Dmitriy Anisimkov * libgnat/g-socket.ads (Level_Type): Add enumerators for diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 077063f5939..99bd8d211cb 100644 --- a/gcc/ada/exp_ch9.adb +++ b/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 := diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index eefe9881548..baef966cb2d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2019-07-11 Ed Schonberg + + * gnat.dg/prot8.adb, gnat.dg/prot8.ads: New testcase. + 2019-07-11 Justin Squirek * gnat.dg/unreferenced2.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/prot8.adb b/gcc/testsuite/gnat.dg/prot8.adb new file mode 100644 index 00000000000..c39044853b6 --- /dev/null +++ b/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; diff --git a/gcc/testsuite/gnat.dg/prot8.ads b/gcc/testsuite/gnat.dg/prot8.ads new file mode 100644 index 00000000000..01424ce4d36 --- /dev/null +++ b/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; -- 2.30.2