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