sem_ch4.adb (Analyze_Allocator): Flag errors on allocators of a nested access…

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

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

gcc/ada/ChangeLog

+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

gcc/ada/sem_ch4.adb

@@ -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

gcc/ada/sem_ch9.adb

@@ -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;