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
|
-- GCH COMPONENTS --
-- --
-- G C H . R U L E S --
-- --
-- QS_5_1_1_1 --
-- --
-- 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_5_1_1_1 --
------------------
-- As a rule to check we use the
-- following: "Associate names with loops when they are nested").
with Asis.Extensions.Flat_Kinds; use Asis.Extensions.Flat_Kinds;
with Gch.Globals; use Gch.Globals;
separate (Gch.Rules)
function QS_5_1_1_1 (E : Element) return Boolean is
E_Kind : Flat_Element_Kinds := Flat_Element_Kind (E);
procedure Check_For_Nested_Loop
(Element : in Asis.Element;
Control : in out Traverse_Control;
State : in out Boolean);
-- used as Operation when traversing a loop. Checks if the component
-- being traversed is a loop statement belonging to this loop and
-- terminate traversing if and when such a loop statement is found;
procedure Check_For_Nested_Loop
(Element : in Asis.Element;
Control : in out Traverse_Control;
State : in out Boolean)
is
Elem_Kind : Flat_Element_Kinds := Flat_Element_Kind (Element);
begin
if not (Is_Identical(Element, E)) and then -- is it nested?
Elem_Kind in Flat_Loop_Statement and then -- is it a loop?
Is_Nil (Statement_Identifier (Element)) -- is it unnamed?
then
-- we have to add violation here because a nested element
-- causes the violation, not the original one
-- ###VK think more about the system structure in general
-- ###Vk if we need any common place for violation adding?
-- ###VK it seems not! Each rule has to manage the adding
Add_Violation (Element, Current_Rule);
State := True;
Control := Terminate_Immediately;
elsif not (Is_Identical(Element, E)) and then
-- to look in deep
(Elem_Kind = An_Accept_Statement or else
Elem_Kind not in Flat_Statement_Kinds)
then
Control := Abandon_Children;
end if;
end Check_For_Nested_Loop;
procedure Look_For_Nested_Loop is new Simple_Traverse_Element
(State_Information => Boolean,
Operation => Check_For_Nested_Loop);
Loop_Found : Boolean := False;
Loop_Search_Control : Traverse_Control := Continue;
begin
if (E_Kind in Flat_Loop_Statement)
then
-- if E is an unnamed loop statement
Look_For_Nested_Loop (E, Loop_Search_Control, Loop_Found);
end if;
return True; -- since all violations are reported inside the routine
exception
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_5_1_1_1");
return True;
end QS_5_1_1_1;
|
