[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  <kirtchev@adacore.com>

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 809fd0af586d55268b60461f6619790d162ef1eb..0cecad091ff08a19c225bc0073461a98dec714e3 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,19 @@
+2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <charlet@adacore.com>
 
        * set_targ.adb: Mark some CodePeer message as Intentional.

diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index e89ea5ad54f2f343c29d77f46c1327ff5244fa9c..c9cdfc202f1abe1fd69cec25564e469f970afbe4 100644 (file)
--- 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 8e5bf659533dcff67ad916c397cb4d03a3c760fc..dbe1ad6d533c884a26ea5816b41805a433aac4c7 100644 (file)
--- 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 a3d8dda36c298199253c001035422dcb5c2b6481..69473383114e425c1f3de8942984ead270219238 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * 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  <schonberg@adacore.com>
 
        * 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 (file)
index 0000000..83b8fbc
--- /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 (file)
index 0000000..3dac0d1
--- /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 (file)
index 0000000..b6a360d
--- /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 (file)
index 0000000..f6343b0
--- /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;