Commit 336878fc by Bob Duff Committed by Pierre-Marie de Rodat

[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
parent 3f3dbb7b
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
......
......@@ -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);
......
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,
......
-- { dg-do run }
with Task2_Pkg; use Task2_Pkg;
procedure Task2 is
X : access T2'Class := new T2;
begin
null;
end Task2;
package body Task2_Pkg is
task body T2 is
begin
null;
end T2;
end Task2_Pkg;
package Task2_Pkg is
type T is task Interface;
task type T2 is new T with end;
end Task2_pkg;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment