[multiple changes]

2008-04-29  Ed Schonberg  <schonberg@adacore.com>

    gcc/ada/
	PR ada/35792
	* sem_ch3.adb (Find_Type_Name): Refuse completion of an incomplete
	tagged type by an untagged protected or task type.

2008-04-29  Samuel Tardieu  <sam@rfc1149.net>

    gcc/testsuite/
	PR ada/35792
	* gnat.dg/specs/tag2.ads: New.

From-SVN: r134810
This commit is contained in:
Samuel Tardieu 2008-04-29 21:43:39 +00:00
parent cf2758e3d4
commit af4133b2b7
4 changed files with 46 additions and 5 deletions

View File

@ -1,3 +1,9 @@
2008-04-29 Ed Schonberg <schonberg@adacore.com>
PR ada/35792
* sem_ch3.adb (Find_Type_Name): Refuse completion of an incomplete
tagged type by an untagged protected or task type.
2008-04-28 Eric Botcazou <ebotcazou@adacore.com>
Tristan Gingold <gingold@adacore.com>

View File

@ -13046,13 +13046,26 @@ package body Sem_Ch3 is
if Is_Type (Prev)
and then (Is_Tagged_Type (Prev)
or else Present (Class_Wide_Type (Prev)))
and then not Nkind_In (N, N_Task_Type_Declaration,
N_Protected_Type_Declaration)
then
-- The full declaration is either a tagged record or an
-- extension otherwise this is an error
-- The full declaration is either a tagged type (including
-- a synchronized type that implements interfaces) or a
-- type extension, otherwise this is an error.
if Nkind_In (N, N_Task_Type_Declaration,
N_Protected_Type_Declaration)
then
if No (Interface_List (N))
and then not Error_Posted (N)
then
Error_Msg_NE
("full declaration of } must be a tagged type ", Id, Prev);
end if;
elsif Nkind (Type_Definition (N)) = N_Record_Definition then
-- Indicate that the previous declaration (tagged incomplete
-- or private declaration) requires the same on the full one.
if Nkind (Type_Definition (N)) = N_Record_Definition then
if not Tagged_Present (Type_Definition (N)) then
Error_Msg_NE
("full declaration of } must be tagged", Prev, Id);

View File

@ -1,3 +1,8 @@
2008-04-29 Samuel Tardieu <sam@rfc1149.net>
PR ada/35792
* gnat.dg/specs/tag2.ads: New.
2008-04-29 Richard Guenther <rguenther@suse.de>
PR tree-optimization/36078

View File

@ -0,0 +1,17 @@
-- { dg-do compile }
package tag2 is
type I is synchronized interface;
type T1 is tagged;
type T2 is tagged;
type T3 is tagged;
type T4 is tagged;
type T5 is tagged;
type T6 is tagged;
protected type T1 is end T1; -- { dg-error "must be a tagged type" }
task type T2; -- { dg-error "must be a tagged type" }
type T3 is null record; -- { dg-error "must be tagged" }
task type T4 is new I with end;
protected type T5 is new I with end;
type T6 is tagged null record;
end tag2;