===================================================================
@@ -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;
===================================================================
@@ -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
The compiler should not reject a nested task type when the restriction No_Task_Hierarchy applies, since only nested task objects violate the restriction. We now issue warnings on both task and protected types declared at nested levels when the respective restrictions No_Task_Hierarchy or No_Local_Protected_Objects apply. Also, allocators of nested access types designating task and protected types are now flagged when the appropriate restriction applies. When the test given below is compiled, the following errors and warnings must be issued: restrict_nested_task_prot.adb:6:04: violation of restriction "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:13:04: warning: objects of this type will violate "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:20:04: violation of restriction "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:24:20: violation of restriction "No_Task_Hierarchy" at line 1 restrict_nested_task_prot.adb:27:14: violation of restriction "No_Local_Protected_Objects" at line 2 restrict_nested_task_prot.adb:33:04: warning: objects of this type will violate "No_Local_Protected_Objects" at line 2 restrict_nested_task_prot.adb:39:04: violation of restriction "No_Local_Protected_Objects" at line 2 restrict_nested_task_prot.adb:43:20: violation of restriction "No_Local_Protected_Objects" at line 2 -- pragma Restrictions (No_Task_Hierarchy); pragma Restrictions (No_Local_Protected_Objects); procedure Restrict_Nested_Task_Prot is task T; -- ERROR task body T is begin null; end T; task type TT; -- WARNING task body TT is begin null; end TT; TT_Obj : TT; -- ERROR type Acc_TT is access all TT; ATT : Acc_TT := new TT; -- ERROR protected P is -- ERROR end P; protected body P is end P; protected type PT is -- WARNING end PT; protected body PT is end PT; PT_Obj : PT; -- ERROR type Acc_PT is access all PT; APT : Acc_PT := new PT; -- ERROR begin null; end Restrict_Nested_Task_Prot; Tested on x86_64-pc-linux-gnu, committed on trunk 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.