1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293
|
------------------------------------------------------------------------------
-- --
-- GCH COMPONENTS --
-- --
-- G C H . R U L E S --
-- --
-- QS_4_3_1_11 --
-- --
-- Copyright (c) 1999, Vitali Sh.Kaufman. --
-- --
-- Gch is distributed as free software; that is with full sources --
-- and in the hope that it will be useful, but WITHOUT ANY WARRANTY; --
-- without even the implied warranty of MERCHANTABILITY or FITNESS --
-- FOR A PARTICULAR PURPOSE. You can freely copy, modify and redistribute --
-- this software, provided that full sources are available for the version --
-- being distribute (original and modified), and for a modified version, --
-- any changes that you have made are clearly indicated. --
-- --
-- Gch was developed by Vitali Sh. Kaufman using a prototype --
-- and consultations by Sergey I. Rybin. --
------------------------------------------------------------------------------
------------------
-- QS_4_3_1_11 --
------------------
-- As a rule to check we use the following:
-- "Never let an exception propagate beyond its scope".
-- ###VK Think more: raiser inside task
-- ###VK Think more: extended calling-caller relation?
--Generally, for each raiser R of an exception Ex the rule needs to check
--if an (dynamically) enclosing block B with a handler H of Ex exists.
--So, the whole rule is impossible to check statically.
--To create some reasonable warnings, we need at least extended "calling-caller"
--relation and "enclosing" relation.
--An idea of a preliminary implementation for now is as follows.
--For each direct raiser R of an exception Ex Check_Raiser (R,Ex,U)
--checks if a handler H of Ex ends a body B
--that enclose R or a potential caller of R (extended raiser of Ex)
--inside a checked compilation unit U
--It is expensive check but it could be optimize
--using a Check_For_Subprogram_Body (Ex). The last would avoid any redundant
--check for a corresponding body that has an appropriate handler H of Ex.
--For now just a simplified version of the rule checking is implemented.
--It is not full enough and uses just a direct (not extended) raisers and
--a simplified optimization (that works for compilation unit bodies only).
--It means that Check_Raiser(R,Ex,U) need not to check any subrogram unit U
--that ends by a handler of Ex.
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
separate (Gch.Rules)
function QS_4_3_1_11 (E : Element) return Boolean is
Arg_Kind : Flat_Element_Kinds := Flat_Element_Kind (E);
-- Kind of the Element being visited.
TempUnit : Asis.Compilation_Unit; -- a temp for units
Ex_Def : Element; -- Exception Name definition for checked exception
Result : Boolean := True; -- function result ###VK-- do we really need it?
-- search Handler_List for references to exceptions of Exc
-- If successes then returns True
-- If fails then returns False
function Check_Handlers (Handler_List : Element_List) return Boolean;
-- checks if raiser E is inside a Handler_list Handl
-- it is made as a function to simplify possible changes
function Is_Raised_Inside (Handl : Element_List) return Boolean;
function Is_Raised_Inside (Handl : Element_List) return Boolean is
Handl_Span : Span := Element_Span (Handl (Handl'First));
Raiser_Span : Span := Element_Span (E);
begin
return Handl_Span.First_Line <= Raiser_Span.First_Line and then
Handl_Span.First_Column <= Raiser_Span.First_Column;
end Is_Raised_Inside;
-- check if a handler for the exception Ex
-- exists for an enclosing body for the raiser E
function Check_Raiser (Ex : Element) return Boolean;
function Check_Raiser (Ex : Element) return Boolean is
-- An attempt to optimize
-- Check_For_Subprogram_Body
Checked_Unit : Compilation_Unit := Enclosing_Compilation_Unit (E);
U_Kind : Unit_Kinds := Unit_Kind (Checked_Unit);
-- ###VK to provide the optimization
-- ###VK uncomment when compiling with ASIS version 3.11b2.2
-- ###VK or later
-- Handler_List : Element_List := Body_Exception_Handlers
-- (Corresponding_Body
-- (Unit_Declaration
-- (Checked_Unit)));
Is_Decl : Boolean := False; -- is used to prevent moving up
-- if Ex_Def raised by Ex has a handler "enclosing" El
function Check_Extended_Raiser (El : Element) return Boolean;
function Check_Extended_Raiser (El : Element) return Boolean is
El_Kind : Flat_Element_Kinds := Flat_Element_Kind (El);
-- working with Handler_List of a statement or declaration Ext
function Check_Ext_Handlers
(Ext : Element; Handler_List : Element_List) return Boolean;
function Check_Ext_Handlers
(Ext : Element; Handler_List : Element_List) return Boolean is
begin
-- Handler_List is a corresponding handler list
if Is_Nil (Handler_List) then
-- move up recursively till appropriate Ext_Kind
return Check_Extended_Raiser (Enclosing_Element (Ext));
end if;
-- is raiser inside the handler list?
if Is_Raised_Inside (Handler_List) then
return True;
end if;
if Check_Handlers (Handler_List) then
return True;
else
-- move up recursively till appropriate Ext_Kind
return Check_Extended_Raiser (Enclosing_Element (Ext));
end if;
end Check_Ext_Handlers;
begin
if Is_Nil (El) or else Is_Decl then
return False;
end if;
-- First of all we try to find a corresponding body for E
if not (El_Kind in Flat_Statement_Kinds
or else El_Kind in Flat_Declaration_Kinds) then
-- move up recursively till appropriate Ext_Kind
return Check_Extended_Raiser (Enclosing_Element (El));
end if;
case El_Kind is
when A_Function_Body_Declaration |
A_Procedure_Body_Declaration
-- | A_Task_Body_Declaration -- ###VK
-- | A_Protected_Body_Declaration -- ###VK
=>
Is_Decl := True; -- to prevent moving up
-- getting corresponding handlers
return Check_Ext_Handlers
(El, Body_Exception_Handlers (El));
when A_Block_Statement
=> return Check_Ext_Handlers
(El, Block_Exception_Handlers (El));
when An_Accept_Statement
-- getting corresponding handlers
=> return Check_Ext_Handlers
(El, Accept_Body_Exception_Handlers (El));
when others
=> -- move up recursively till appropriate Ext_Kind
return Check_Extended_Raiser (Enclosing_Element (El));
end case;
end Check_Extended_Raiser;
begin
Ex_Def := Corresponding_Name_Definition (Ex);
-- An attempt to optimize the check
-- ###VK to provide the optimization
-- ###VK uncomment when compiling with ASIS version 3.11b2.2
-- ###VK or later
-- if U_Kind = A_Procedure or else
-- U_Kind = A_Function or else
-- U_Kind = A_Procedure_Body or else
-- U_Kind = A_Function_Body or else
-- U_Kind = A_Procedure_Body or else
-- U_Kind = A_Procedure_Body_Subunit or else
-- U_Kind = A_Function_Body_Subunit
-- then
-- if not Is_Nil (Handler_List) and then
-- Check_Handlers (Handler_list)
-- then
-- return True;
-- end if;
-- end if;
-- if Ex_Def raised by Ex has a handler "enclosing" E
return Check_Extended_Raiser (Enclosing_Element (E));
end Check_Raiser;
function Check_Handlers (Handler_List : Element_List) return Boolean is
begin
-- Pre-condition: not Is_Nil (Handler_List)
declare -- Check for "other" choice
Last_Handler : Element := Handler_List (Handler_List'Last);
Choices : Element_List := Exception_Choices (Last_Handler);
Last_Choice : Element := Choices (Choices'Last);
begin
if Definition_Kind (Last_Choice) = An_Others_Choice then
return True;
end if;
end;
for J in Handler_List'range loop
declare
Choices : Element_List := Exception_Choices (Handler_List (J));
begin
for K in Choices'range loop
declare
Choice_K : Element := Choices (K);
Choice_Kind : Flat_Element_Kinds :=
Flat_Element_Kind (Choice_K);
Handling_Exception : Element;
begin
if Choice_Kind = A_Selected_Component then
Handling_Exception := Corresponding_Name_Definition
(Selector (Choice_K));
else
Handling_Exception := Corresponding_Name_Definition
(Choice_K);
end if;
if Is_Equal (Ex_Def, Handling_Exception) then
-- Ex_Def is_referenced by Choices (K)
return True;
end if;
end;
end loop;
end;
end loop;
-- No handler for the exception Exc
return False;
end Check_Handlers;
begin
-- we have to ignore any predefined exception in the rule
-- that is why we check here a rule concerning raising of
-- predefined exceptions QS_4_3_1_10
if not QS_4_3_1_10 (E) then
return True;
end if;
case Arg_Kind is
-- a raise statement
when A_Raise_Statement =>
declare
-- check if a handler for Raised_Exception (E)
-- exists for an enclosing body for the raiser E
Raised : Element := Raised_Exception (E);
Raise_Kind : Flat_Element_Kinds;
begin
if Is_Nil (Raised) then
return True; -- empty raiser should be ignored
end if;
Raise_Kind := Flat_Element_Kind (Raised);
if Raise_Kind = A_Selected_Component then
Raised := Selector (Raised);
end if;
return Check_Raiser (Raised);
end;
-- nothing concerning exception raising
when others => return True;
end case;
return Result; -- do we need this here?
exception -- ###VK to think more concerning list of exceptions
-- and also moving such handlers one step up
when Asis_Inappropriate_Context |
Asis_Inappropriate_Container |
Asis_Inappropriate_Compilation_Unit |
Asis_Inappropriate_Element |
Asis_Inappropriate_Line |
Asis_Inappropriate_Line_Number |
Asis_Failed
=>
Report_Asis_Failure ("QS_4_3_1_11");
return True;
end QS_4_3_1_11;
|