Patchwork [Ada] Error wrongly given for nested tagged types when No_Task_Hierarchy applies

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 5, 2010, 8:57 a.m.
Message ID <20100805085703.GA8812@adacore.com>
Download mbox | patch
Permalink /patch/60939/
State New
Headers show

Comments

Arnaud Charlet - Aug. 5, 2010, 8:57 a.m.
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.

Patch

Index: sem_ch9.adb
===================================================================
--- sem_ch9.adb	(revision 162866)
+++ sem_ch9.adb	(working copy)
@@ -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;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb	(revision 162901)
+++ sem_ch4.adb	(working copy)
@@ -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