[Ada] Crash on anonymous access-to-class-wide with tasks

This patch fixes a bug in which if an object declaration is of an
anonymous access type whose designated type is a limited class-wide type
(but not an interface), and the object is initialized with an allocator,
and the designated type of the allocator contains tasks, the compiler
would crash.

2019-07-03  Bob Duff  <duff@adacore.com>

gcc/ada/

	* sem_ch3.adb (Access_Definition): The code was creating a
	master in the case where the designated type is a class-wide
	interface type. Create a master in the noninterface case as
	well. That is, create a master for all limited class-wide types.

gcc/testsuite/

	* gnat.dg/task2.adb, gnat.dg/task2_pkg.adb,
	gnat.dg/task2_pkg.ads: New testcase.

From-SVN: r272986

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 859380f9aa3c36372ba9d80af8b5bb6b3d0e59d4..97f95afc69d7b3eb6a93ade8f43133a2d3b17ef1 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-03  Bob Duff  <duff@adacore.com>
+
+       * sem_ch3.adb (Access_Definition): The code was creating a
+       master in the case where the designated type is a class-wide
+       interface type. Create a master in the noninterface case as
+       well. That is, create a master for all limited class-wide types.
+
 2019-07-03  Yannick Moy  <moy@adacore.com>
 
        * erroutc.adb (Sloc_In_Range): New function to determine whether

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 9fff6b6c9664cdacbfc7adbb74b953cb8c952fba..75a00996b858fff904bc28a9ae67a397da588776 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -924,15 +924,16 @@ package body Sem_Ch3 is
          Set_Has_Delayed_Freeze (Current_Scope);
       end if;
 
-      --  Ada 2005: If the designated type is an interface that may contain
-      --  tasks, create a Master entity for the declaration. This must be done
-      --  before expansion of the full declaration, because the declaration may
-      --  include an expression that is an allocator, whose expansion needs the
-      --  proper Master for the created tasks.
+      --  If the designated type is limited and class-wide, the object might
+      --  contain tasks, so we create a Master entity for the declaration. This
+      --  must be done before expansion of the full declaration, because the
+      --  declaration may include an expression that is an allocator, whose
+      --  expansion needs the proper Master for the created tasks.
 
       if Nkind (Related_Nod) = N_Object_Declaration and then Expander_Active
       then
-         if Is_Interface (Desig_Type) and then Is_Limited_Record (Desig_Type)
+         if Is_Limited_Record (Desig_Type)
+           and then Is_Class_Wide_Type (Desig_Type)
          then
             Build_Class_Wide_Master (Anon_Type);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3b615398f8685c8649b19074326e4d3d6ac49752..6be173965c0622089bb4d3578e211e580eb9e6ff 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-03  Bob Duff  <duff@adacore.com>
+
+       * gnat.dg/task2.adb, gnat.dg/task2_pkg.adb,
+       gnat.dg/task2_pkg.ads: New testcase.
+
 2019-07-03  Ed Schonberg  <schonberg@adacore.com>
 
        * gnat.dg/inline16.adb, gnat.dg/inline16_gen.adb,

diff --git a/gcc/testsuite/gnat.dg/task2.adb b/gcc/testsuite/gnat.dg/task2.adb
new file mode 100644 (file)
index 0000000..f7a8159
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/task2.adb
@@ -0,0 +1,9 @@
+--  { dg-do run }
+
+with Task2_Pkg; use Task2_Pkg;
+
+procedure Task2 is
+   X : access T2'Class := new T2;
+begin
+   null;
+end Task2;

diff --git a/gcc/testsuite/gnat.dg/task2_pkg.adb b/gcc/testsuite/gnat.dg/task2_pkg.adb
new file mode 100644 (file)
index 0000000..9481a57
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/task2_pkg.adb
@@ -0,0 +1,6 @@
+package body Task2_Pkg is
+   task body T2 is
+   begin
+      null;
+   end T2;
+end Task2_Pkg;

diff --git a/gcc/testsuite/gnat.dg/task2_pkg.ads b/gcc/testsuite/gnat.dg/task2_pkg.ads
new file mode 100644 (file)
index 0000000..b4ef37c
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/task2_pkg.ads
@@ -0,0 +1,4 @@
+package Task2_Pkg is
+   type T is task Interface;
+   task type T2 is new T with end;
+end Task2_pkg;