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 | with Ada.Characters.Handling;
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Exceptions;
with Ada.Strings.Fixed;
with GNAT.IO;
with Simple_Logging.Decorators;
package body Simple_Logging.Filtering is
package String_Sets is new Ada.Containers.Indefinite_Ordered_Sets (String);
Substrings : String_Sets.Set;
Exceptions : String_Sets.Set;
--------------
-- Contains --
--------------
function Contains (Text, Substring : String) return Boolean is
(Ada.Strings.Fixed.Index
(Ada.Characters.Handling.To_Lower (Text), Substring) > 0);
-- patterns are lowercased on agregation.
--------------------
-- Default_Filter --
--------------------
function Default_Filter (Message : String;
Level : Levels;
Entity : String;
Location : String) return Boolean
is
pragma Unreferenced (Message, Level);
Found : Boolean := False;
Except : Boolean := False;
begin
for Str of Substrings loop
if Contains (Entity, Str) or else Contains (Location, Str) then
Found := True;
exit;
end if;
end loop;
if Found then
for Str of Exceptions loop
if Contains (Entity, Str) or else Contains (Location, Str) then
Except := True;
exit;
end if;
end loop;
end if;
return
(Mode = Blacklist and then (not Found or else Except)) or else
(Mode = Whitelist and then (Found and then not Except));
end Default_Filter;
-------------------
-- Add_Substring --
-------------------
procedure Add_Substring (Str : String) is
begin
Substrings.Include (Ada.Characters.Handling.To_Lower (Str));
end Add_Substring;
-------------------
-- Add_Exception --
-------------------
procedure Add_Exception (Str : String) is
begin
Exceptions.Include (Ada.Characters.Handling.To_Lower (Str));
end Add_Exception;
---------------------
-- Add_From_String --
---------------------
function Add_From_String (Str : String;
Say : Boolean := False) return Boolean is
Bad_Syntax : exception;
----------------
-- Add_Scopes --
----------------
procedure Add_Scopes (Debug_Arg : String) is
-- Receives as-is the --debug/-d[ARG] argument. This is a list of
-- optionally comma-separated, plus/minus prefixed substrings that will
-- be used for filtering against the enclosing entity/source location.
-- Example whitelisting argument: +commands,-search
-- Example blacklisting argument: -commands,+search
-- The first sign puts the filter in (-) blacklist / (+) whitelist mode.
-- In whitelist mode, only the given substrings are logged, unless later
-- added as exception. E.g., in the "+commands,-search" example, only
-- commands traces would be logged (because of whitelist mode), except
-- the ones for the search command (because given as an exception).
-- In the "-commands,+search" example for blacklist mode, everything but
-- command traces would be logged, but search command traces would be
-- logged because that's the exception.
-- Once scopes are used, we activate logging of enclosing entity and
-- location to provide full logging information.
Pos : Integer := Debug_Arg'First;
-- Points to the beginning of the next scope in Debug_Arg
--------------------
-- Next_With_Sign --
--------------------
function Next_With_Sign return String is
-- Look from Debug_Arg (Pos) onwards to find a comma, sign, or end.
-- Returns "" when no more scopes. Otherwise, returns a single scope
-- with its sign (e.g., "+commands")
Old_Pos : constant Integer := Pos;
begin
if Pos >= Debug_Arg'Last then
return "";
end if;
for I in Pos + 1 .. Debug_Arg'Last loop
if Debug_Arg (I) in ',' | '+' | '-' then
if Pos = I - 1 then -- Means consecutive separators, i.e. no-no
raise Bad_Syntax with "Invalid logging scope separator: " & Debug_Arg;
end if;
Pos := I;
if Debug_Arg (Pos) = ',' then
Pos := Pos + 1;
end if;
return Debug_Arg (Old_Pos .. I - 1);
end if;
end loop;
-- We reached the end:
Pos := Debug_Arg'Last + 1;
return Debug_Arg (Old_Pos .. Debug_Arg'Last);
end Next_With_Sign;
begin
if Str = "" then
return;
end if;
-- Activate scope logging:
Decorators.Location_Decorator :=
Decorators.Simple_Location_Decorator'Access;
case Debug_Arg (Str'First) is
when '+' =>
Simple_Logging.Filtering.Mode := Whitelist;
when '-' =>
Simple_Logging.Filtering.Mode := Blacklist;
when others =>
raise Bad_Syntax
with "Debug filters must be prefixed with + or -.";
end case;
-- Output how we are going to filter:
if Say then
GNAT.IO.Put_Line ("Filtering mode: "
& Simple_Logging.Filtering.Mode'Img);
end if;
-- Process scopes according to mode and sign
loop
declare
Scope_With_Sign : constant String := Next_With_Sign;
begin
-- Nothing more to process
if Scope_With_Sign = "" then
return;
end if;
-- Add a single scope
declare
Sign : constant Character :=
Scope_With_Sign (Scope_With_Sign'First);
Scope : constant String :=
Scope_With_Sign (Scope_With_Sign'First + 1 ..
Scope_With_Sign'Last);
begin
if Sign not in '-' | '+' then
raise Bad_Syntax with
"ERROR: Missing +/- before filter: " & Scope_With_Sign;
end if;
if (Filtering.Mode = Filtering.Blacklist and then Sign = '-') or
(Filtering.Mode = Filtering.Whitelist and then Sign = '+')
then
if Say then
GNAT.IO.Put_Line ("Filtering substring: " & Scope);
end if;
Filtering.Add_Substring (Scope);
else
if Say then
GNAT.IO.Put_Line ("Filtering exception: " & Scope);
end if;
Filtering.Add_Exception (Scope);
end if;
end;
end;
end loop;
end Add_Scopes;
begin
Add_Scopes (Str);
return True;
exception
when E : Bad_Syntax =>
Mode := Blacklist;
Substrings.Clear;
Exceptions.Clear;
if Say then
GNAT.IO.Put_Line (Ada.Exceptions.Exception_Message (E));
end if;
return False;
end Add_From_String;
end Simple_Logging.Filtering;
|