1----------------------------------------------------------------------
2--  Rules.Terminating_Tasks - Package body                          --
3--                                                                  --
4--  This software  is (c) Adalog  2004-2005. The Ada  Controller is --
5--  free software;  you can redistribute it and/or  modify it under --
6--  terms of  the GNU  General Public License  as published  by the --
7--  Free Software Foundation; either version 2, or (at your option) --
8--  any later version.   This unit is distributed in  the hope that --
9--  it will be  useful, but WITHOUT ANY WARRANTY;  without even the --
10--  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR --
11--  PURPOSE.  See the GNU  General Public License for more details. --
12--  You  should have  received a  copy  of the  GNU General  Public --
13--  License distributed  with this  program; see file  COPYING.  If --
14--  not, write to  the Free Software Foundation, 59  Temple Place - --
15--  Suite 330, Boston, MA 02111-1307, USA.                          --
16--                                                                  --
17--  As  a special  exception, if  other files  instantiate generics --
18--  from the units  of this program, or if you  link this unit with --
19--  other files  to produce  an executable, this  unit does  not by --
20--  itself cause the resulting executable  to be covered by the GNU --
21--  General  Public  License.   This  exception  does  not  however --
22--  invalidate any  other reasons why the executable  file might be --
23--  covered by the GNU Public License.                              --
24--                                                                  --
25--  This  software is  distributed  in  the hope  that  it will  be --
26--  useful,  but WITHOUT  ANY  WARRANTY; without  even the  implied --
27--  warranty  of  MERCHANTABILITY   or  FITNESS  FOR  A  PARTICULAR --
28--  PURPOSE.                                                        --
29----------------------------------------------------------------------
30
31-- Asis
32with
33  Asis.Declarations,
34  Asis.Elements,
35  Asis.Iterator,
36  Asis.Statements;
37
38-- Adalog
39with
40  Utilities;
41
42package body Rules.Terminating_Tasks is
43   use Framework, Framework.Control_Manager;
44
45   -- Algorithm:
46   --
47   -- This algorithm is quite simple since it looks for terminating tasks, i.e.
48   -- tasks that have statements terminating it.
49   --
50   -- First of all, we need to retrieve the task body statements.
51   --
52   -- Then, we look if the last statement is an unconditional loop.
53   --    * When this last statement is not an unconditional loop, the task may
54   --      be considered as a terminating task.
55   --    * In any other case, we need to check that this unconditional loop does
56   --      not contain any `exit' statement refering to it, nor any `terminate`
57   --      alternative within a `select' block.
58   --      When we match one of these cases, the task may be considered as a
59   --      terminating task.
60
61
62   Rule_Used : Boolean := False;
63   Save_Used : Boolean;
64
65   Usage     : Basic_Rule_Context;
66
67   ----------
68   -- Help --
69   ----------
70
71   procedure Help is
72      use Utilities;
73   begin
74      User_Message ("Rule: " & Rule_Id);
75      User_Message ("Control task termination.");
76      User_Message;
77      User_Message ("Parameter(s): none");
78   end Help;
79
80
81   -----------------
82   -- Add_Control --
83   -----------------
84
85   procedure Add_Control (Ctl_Label : in Wide_String; Ctl_Kind : in Control_Kinds) is
86      use Framework.Language;
87   begin
88      if Parameter_Exists then
89         Parameter_Error (Rule_Id, "No parameter allowed");
90      end if;
91
92      if Rule_Used then
93         Parameter_Error (Rule_Id, "Rule can be specified only once");
94      end if;
95
96      Rule_Used := True;
97      Usage     := Basic.New_Context (Ctl_Kind, Ctl_Label);
98   end Add_Control;
99
100
101   -------------
102   -- Command --
103   -------------
104
105   procedure Command (Action : in Framework.Rules_Manager.Rule_Action) is
106      use Framework.Rules_Manager;
107   begin
108      case Action is
109         when Clear =>
110            Rule_Used := False;
111         when Suspend =>
112            Save_Used := Rule_Used;
113            Rule_Used := False;
114         when Resume =>
115            Rule_Used := Save_Used;
116      end case;
117   end Command;
118
119
120   -----------------------
121   -- Process_Task_Body --
122   -----------------------
123
124   procedure Process_Task_Body (Body_Decl : in Asis.Declaration) is
125      use Asis, Asis.Declarations, Asis.Elements;
126      use Framework.Reports;
127
128      Last_Statement : Asis.Statement;
129
130      --------------
131      -- Traverse --
132      --------------
133
134      procedure Pre_Procedure  (Element : in     Asis.Element;
135                                Control : in out Asis.Traverse_Control;
136                                State   : in out Null_State);
137
138      procedure Traverse is new Asis.Iterator.Traverse_Element (Null_State, Pre_Procedure, Null_State_Procedure);
139
140      procedure Pre_Procedure  (Element : in     Asis.Element;
141                                Control : in out Asis.Traverse_Control;
142                                State   : in out Null_State)
143      is
144         pragma Unreferenced (Control, State);
145
146         use Asis.Statements;
147      begin
148         case Statement_Kind (Element) is
149            when An_Exit_Statement =>
150               if Is_Equal (Last_Statement, Corresponding_Loop_Exited (Element)) then
151                  Report (Rule_Id,
152                          Usage,
153                          Get_Location (Last_Statement),
154                          "unconditional loop exited from " & Image (Get_Location (Element)));
155               end if;
156
157            when A_Terminate_Alternative_Statement =>
158               Report (Rule_Id,
159                       Usage,
160                       Get_Location (Last_Statement),
161                       "terminate alternative at " & Image (Get_Location (Element)));
162
163            when others =>
164               null;
165         end case;
166      end Pre_Procedure;
167
168      The_Control : Asis.Traverse_Control := Continue;
169      The_State   : Null_State;
170   begin  -- Process_Task_Body
171      if not Rule_Used then
172         return;
173      end if;
174      Rules_Manager.Enter (Rule_Id);
175
176      declare
177         -- Retrieve the task body statements
178         Task_Statements : constant Asis.Statement_List := Body_Statements (Body_Decl);
179      begin
180         -- Retrieve the last statement of the task body
181         Last_Statement := Task_Statements (Task_Statements'Last);
182         case Statement_Kind (Last_Statement) is
183            when A_Loop_Statement =>
184               -- Check for terminating task
185               Traverse (Last_Statement, The_Control, The_State);
186            when others =>
187               Report (Rule_Id,
188                       Usage,
189                       Get_Location (Last_Statement),
190                       "last statement is not an unconditional loop");
191         end case;
192      end;
193   end Process_Task_Body;
194
195begin  -- Rules.Terminating_Tasks
196   Framework.Rules_Manager.Register (Rule_Id,
197                                     Rules_Manager.Semantic,
198                                     Help_CB        => Help'Access,
199                                     Add_Control_CB => Add_Control'Access,
200                                     Command_CB     => Command'Access);
201end Rules.Terminating_Tasks;
202