From 3f99a611cab3ff6f5dab0e99ec2cf3a89b99cb1b Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Tue, 21 Aug 2018 14:44:56 +0000 Subject: [PATCH] [Ada] Crash on entry in generic with dynamic elaboration checks This patch modifies the set of attributes that applies to entries and entry families to include elaboration entities used by the access-before-elaboration mechanism. 2018-08-21 Hristian Kirtchev gcc/ada/ * einfo.adb (Elaboration_Entity): Include entries and entry families in the set of legal entities. (Elaboration_Entity_Required): Include entries and entry families in the set of legal entities. (Set_Elaboration_Entity): Include entries and entry families in the set of legal entities. (Set_Elaboration_Entity_Required): Include entries and entry families in the set of legal entities. (Write_Field13_Name): Update the output of attribute Elaboration_Entity. * einfo.ads: Attributes Elaboration_Entity and Elaboration_Entity_Required now apply to entries and entry families. gcc/testsuite/ * gnat.dg/elab6.adb, gnat.dg/elab6.ads, gnat.dg/elab6_pkg.adb, gnat.dg/elab6_pkg.ads: New testcase. From-SVN: r263712 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/einfo.adb | 12 +++++++----- gcc/ada/einfo.ads | 15 ++++++++------- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/elab6.adb | 8 ++++++++ gcc/testsuite/gnat.dg/elab6.ads | 6 ++++++ gcc/testsuite/gnat.dg/elab6_pkg.adb | 17 +++++++++++++++++ gcc/testsuite/gnat.dg/elab6_pkg.ads | 4 ++++ 8 files changed, 71 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/elab6.adb create mode 100644 gcc/testsuite/gnat.dg/elab6.ads create mode 100644 gcc/testsuite/gnat.dg/elab6_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/elab6_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 809fd0af586..0cecad091ff 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2018-08-21 Hristian Kirtchev + + * einfo.adb (Elaboration_Entity): Include entries and entry + families in the set of legal entities. + (Elaboration_Entity_Required): Include entries and entry + families in the set of legal entities. + (Set_Elaboration_Entity): Include entries and entry families in + the set of legal entities. + (Set_Elaboration_Entity_Required): Include entries and entry + families in the set of legal entities. + (Write_Field13_Name): Update the output of attribute + Elaboration_Entity. + * einfo.ads: Attributes Elaboration_Entity and + Elaboration_Entity_Required now apply to entries and entry + families. + 2018-08-21 Arnaud Charlet * set_targ.adb: Mark some CodePeer message as Intentional. diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index e89ea5ad54f..c9cdfc202f1 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -1182,7 +1182,7 @@ package body Einfo is pragma Assert (Is_Subprogram (Id) or else - Ekind (Id) = E_Package + Ekind_In (Id, E_Entry, E_Entry_Family, E_Package) or else Is_Generic_Unit (Id)); return Node13 (Id); @@ -1193,7 +1193,7 @@ package body Einfo is pragma Assert (Is_Subprogram (Id) or else - Ekind (Id) = E_Package + Ekind_In (Id, E_Entry, E_Entry_Family, E_Package) or else Is_Generic_Unit (Id)); return Flag174 (Id); @@ -4412,7 +4412,7 @@ package body Einfo is pragma Assert (Is_Subprogram (Id) or else - Ekind (Id) = E_Package + Ekind_In (Id, E_Entry, E_Entry_Family, E_Package) or else Is_Generic_Unit (Id)); Set_Node13 (Id, V); @@ -4423,7 +4423,7 @@ package body Einfo is pragma Assert (Is_Subprogram (Id) or else - Ekind (Id) = E_Package + Ekind_In (Id, E_Entry, E_Entry_Family, E_Package) or else Is_Generic_Unit (Id)); Set_Flag174 (Id, V); @@ -10355,7 +10355,9 @@ package body Einfo is => Write_Str ("Component_Clause"); - when E_Function + when E_Entry + | E_Entry_Family + | E_Function | E_Procedure | E_Package | Generic_Unit_Kind diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 8e5bf659533..dbe1ad6d533 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1090,10 +1090,10 @@ package Einfo is -- to the spec as possible. -- Elaboration_Entity (Node13) --- Defined in generic and non-generic package and subprogram entities. --- This is a counter associated with the unit that is initially set to --- zero, is incremented when an elaboration request for the unit is --- made, and is decremented when a finalization request for the unit +-- Defined in entry, entry family, [generic] package, and subprogram +-- entities. This is a counter associated with the unit that is initially +-- set to zero, is incremented when an elaboration request for the unit +-- is made, and is decremented when a finalization request for the unit -- is made. This is used for three purposes. First, it is used to -- implement access before elaboration checks (the counter must be -- non-zero to call a subprogram at elaboration time). Second, it is @@ -1110,9 +1110,9 @@ package Einfo is -- is elaboration code), but is simply not used for any purpose. -- Elaboration_Entity_Required (Flag174) --- Defined in generic and non-generic package and subprogram entities. --- Set only if Elaboration_Entity is non-Empty to indicate that the --- counter is required to be non-zero even if there is no other +-- Defined in entry, entry family, [generic] package, and subprogram +-- entities. Set only if Elaboration_Entity is non-Empty to indicate that +-- the counter is required to be non-zero even if there is no other -- elaboration code. This occurs when the Elaboration_Entity counter -- is used for access before elaboration checks. If the counter is -- only used to prevent multiple execution of the elaboration code, @@ -6058,6 +6058,7 @@ package Einfo is -- E_Entry_Family -- Protected_Body_Subprogram (Node11) -- Barrier_Function (Node12) + -- Elaboration_Entity (Node13) -- Postconditions_Proc (Node14) -- Entry_Parameters_Type (Node15) -- First_Entity (Node17) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index a3d8dda36c2..69473383114 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-08-21 Hristian Kirtchev + + * gnat.dg/elab6.adb, gnat.dg/elab6.ads, gnat.dg/elab6_pkg.adb, + gnat.dg/elab6_pkg.ads: New testcase. + 2018-08-21 Ed Schonberg * gnat.dg/expr_func5.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/elab6.adb b/gcc/testsuite/gnat.dg/elab6.adb new file mode 100644 index 00000000000..83b8fbcaeff --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab6.adb @@ -0,0 +1,8 @@ +-- { dg-do compile } +-- { dg-options "-gnatE" } + +package body Elab6 is + procedure Force_Body is null; + + package Inst is new Elab6_Pkg; +end Elab6; diff --git a/gcc/testsuite/gnat.dg/elab6.ads b/gcc/testsuite/gnat.dg/elab6.ads new file mode 100644 index 00000000000..3dac0d176cf --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab6.ads @@ -0,0 +1,6 @@ +with Elab6_Pkg; + +generic +package Elab6 is + procedure Force_Body; +end Elab6; diff --git a/gcc/testsuite/gnat.dg/elab6_pkg.adb b/gcc/testsuite/gnat.dg/elab6_pkg.adb new file mode 100644 index 00000000000..b6a360d3f56 --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab6_pkg.adb @@ -0,0 +1,17 @@ +package body Elab6_Pkg is + protected Prot_Obj is + entry Ent; + end Prot_Obj; + + procedure Call_Ent is + begin + Prot_Obj.Ent; + end Call_Ent; + + protected body Prot_Obj is + entry Ent when True is + begin + null; + end Ent; + end Prot_Obj; +end Elab6_Pkg; diff --git a/gcc/testsuite/gnat.dg/elab6_pkg.ads b/gcc/testsuite/gnat.dg/elab6_pkg.ads new file mode 100644 index 00000000000..f6343b05593 --- /dev/null +++ b/gcc/testsuite/gnat.dg/elab6_pkg.ads @@ -0,0 +1,4 @@ +generic +package Elab6_Pkg is + procedure Call_Ent; +end Elab6_Pkg; -- 2.30.2