OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_ch4.adb (Analyze_Allocator): Flag errors on allocators of a nested access type whose designated type has...

Browse Source 
2010-08-05  Gary Dismukes  <dismukes@adacore.com>

	* sem_ch4.adb (Analyze_Allocator): Flag errors on allocators of a
	nested access type whose designated type has tasks or is a protected
	object when the restrictions No_Task_Hierarchy or
	No_Local_Protected_Objects apply. Add ??? comment.
	* sem_ch9.adb (Analyze_Protected_Type): Give a warning when a protected
	type is not a library-level type and No_Local_Protected_Objects applies.
	(Analyze_Task_Type): Give a warning when a task type is not a
	library-level type and No_Task_Hierarchy applies.

From-SVN: r162902
This commit is contained in:
Gary Dismukes 2010-08-05 08:55:34 +00:00 committed by Arnaud Charlet
parent d2f25cd144
commit 70b3b95343
3 changed files with 68 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2010-08-05 Gary Dismukes <dismukes@adacore.com>
* sem_ch4.adb (Analyze_Allocator): Flag errors on allocators of a
nested access type whose designated type has tasks or is a protected
object when the restrictions No_Task_Hierarchy or
No_Local_Protected_Objects apply. Add ??? comment.
* sem_ch9.adb (Analyze_Protected_Type): Give a warning when a protected
type is not a library-level type and No_Local_Protected_Objects applies.
(Analyze_Task_Type): Give a warning when a task type is not a
library-level type and No_Task_Hierarchy applies.
2010-08-05 Arnaud Charlet <charlet@adacore.com>
* sem.adb: Minor reformatting

19
gcc/ada/sem_ch4.adb
View File

@ -590,6 +590,25 @@ package body Sem_Ch4 is
Check_Restriction (No_Tasking, N);
Check_Restriction (Max_Tasks, N);
Check_Restriction (No_Task_Allocators, N);
-- Check that an allocator with task parts isn't for a nested access
-- type when restriction No_Task_Hierarchy applies.
if not Is_Library_Level_Entity (Acc_Type) then
Check_Restriction (No_Task_Hierarchy, N);
end if;
end if;
-- Check that an allocator of a nested access type doesn't create a
-- protected object when restriction No_Local_Protected_Objects applies.
-- We don't have an equivalent to Has_Task for protected types, so only
-- cases where the designated type itself is a protected type are
-- currently checked. ???
if Is_Protected_Type (Designated_Type (Acc_Type))
and then not Is_Library_Level_Entity (Acc_Type)
then
Check_Restriction (No_Local_Protected_Objects, N);
end if;
-- If the No_Streams restriction is set, check that the type of the

40
gcc/ada/sem_ch9.adb
View File

@ -1178,6 +1178,27 @@ package body Sem_Ch9 is
Analyze (Protected_Definition (N));
-- In the case where the protected type is declared at a nested level
-- and the No_Local_Protected_Objects restriction applies, issue a
-- warning that objects of the type will violate the restriction.
if not Is_Library_Level_Entity (T)
and then Comes_From_Source (T)
and then Restrictions.Set (No_Local_Protected_Objects)
then
Error_Msg_Sloc := Restrictions_Loc (No_Local_Protected_Objects);
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate " &
"`No_Local_Protected_Objects`?", N);
else
Error_Msg_N
("objects of this type will violate " &
"`No_Local_Protected_Objects`?#", N);
end if;
end if;
-- Protected types with entries are controlled (because of the
-- Protection component if nothing else), same for any protected type
-- with interrupt handlers. Note that we need to analyze the protected
@ -1970,8 +1991,23 @@ package body Sem_Ch9 is
Analyze_Task_Definition (Task_Definition (N));
end if;
if not Is_Library_Level_Entity (T) then
Check_Restriction (No_Task_Hierarchy, N);
-- In the case where the task type is declared at a nested level and the
-- No_Task_Hierarchy restriction applies, issue a warning that objects
-- of the type will violate the restriction.
if not Is_Library_Level_Entity (T)
and then Comes_From_Source (T)
and then Restrictions.Set (No_Task_Hierarchy)
then
Error_Msg_Sloc := Restrictions_Loc (No_Task_Hierarchy);
if Error_Msg_Sloc = No_Location then
Error_Msg_N
("objects of this type will violate `No_Task_Hierarchy`?", N);
else
Error_Msg_N
("objects of this type will violate `No_Task_Hierarchy`?#", N);
end if;
end if;
End_Scope;