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;