From 336878fc11b75f8ac962efd9150151b74685f7fb Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Wed, 3 Jul 2019 08:16:24 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_ch3.adb | 13 +++++++------ gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gnat.dg/task2.adb | 9 +++++++++ gcc/testsuite/gnat.dg/task2_pkg.adb | 6 ++++++ gcc/testsuite/gnat.dg/task2_pkg.ads | 4 ++++ 6 files changed, 38 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/task2.adb create mode 100644 gcc/testsuite/gnat.dg/task2_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/task2_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 859380f9aa3..97f95afc69d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-03 Bob Duff + + * 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 * 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 9fff6b6c966..75a00996b85 100644 --- 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 3b615398f86..6be173965c0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2019-07-03 Bob Duff + + * gnat.dg/task2.adb, gnat.dg/task2_pkg.adb, + gnat.dg/task2_pkg.ads: New testcase. + 2019-07-03 Ed Schonberg * 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 index 00000000000..f7a8159ea07 --- /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 index 00000000000..9481a57597d --- /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 index 00000000000..b4ef37c1c84 --- /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; -- 2.30.2