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.

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

2019-07-03  Bob Duff  <d...@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.
--- gcc/ada/sem_ch3.adb
+++ 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);
 

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

--- /dev/null
new file mode 100644
+++ 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;

Reply via email to