adacl-trace.ads

1--------------------------------------------------------------- {{{1 ----------
2--: Copyright © 2007 … 2023 Martin Krischik «krischik@users.sourceforge.net»
3-----------------------------------------------------------------------------
4--: This library is free software; you can redistribute it and/or modify it
5--: under the terms of the GNU Library General Public License as published by
6--: the Free Software Foundation; either version 2 of the License, or (at your
7--: option) any later version.
8--:
9--: This library is distributed in the hope that it will be useful, but
10--: WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
11--: or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
12--: License for more details.
13--:
14--: You should have received a copy of the GNU Library General Public License
15--: along with this library; if not, write to the Free Software Foundation,
16--: Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
17--------------------------------------------------------------- }}}1 ----------
18
19pragma License (Modified_Gpl);
20pragma Ada_2022;
21
22with Ada.Assertions;
23with Ada.Containers.Indefinite_Vectors;
24with Ada.Exceptions;
25with Ada.Strings.Unbounded;
26with Ada.Strings.Wide_Unbounded;
27with Ada.Strings.Wide_Wide_Unbounded;
28with AdaCL.Base;
29with GNAT.Source_Info;
30with System.Storage_Elements;
31with System;
32
33---
34-- @summary
35--
36-- @description
37package AdaCL.Trace is
38 package Parameter_Vectors is new Ada.Containers.Indefinite_Vectors (Index_Type => Positive, Element_Type => String);
39
40 Parameter : Parameter_Vectors.Vector renames Parameter_Vectors.Empty_Vector;
41
42 ---
43 -- Keep internal data for function traces
44 --: @field Name_Length Length of trace String
45 --
46 type Object (Name_Length : Positive) is new Base.Object with private;
47
48 ---
49 -- Trace Destination
50 --
51 --: @value Queue Trace to system queue
52 --: @value Standard_Error Trace to standart error
53 --: @value Standard_Output Trace to standart output
54 --: @value File Trace to file
55 type Destination is
56 (Queue,
57 Standard_Error,
58 Standard_Output,
59 File);
60
61 ---
62 -- Initialize trace from environment variable and commandline
63 --
64 procedure Initialize;
65
66 ---
67 -- Functrace is not quite as usefull as the C++ version. The reason are the missing constructors and destructors in
68 -- Ada. With Controlled types you can't limit to just one call to Initialize and one to Finalize There are allways
69 -- some extra Adjust with matching. Finalize.
70 --
71 --: @param Name Name of the function calls to be traced.
72 --
73 function Function_Trace (Name : in String) return Object with
74 Inline;
75
76 ---
77 -- Functrace is not quite as usefull as the C++ version. The reason are the missing constructors and destructors in
78 -- Ada. With Controlled types you can't limit to just one call to Initialize and one to Finalize There are allways
79 -- some extra Adjust with matching. Finalize.
80 --
81 --: @param Entity Name of the function calls to be traced.
82 --: @param Source Source Line to be traced
83 --
84 function Function_Trace
85 (Entity : in String := GNAT.Source_Info.Enclosing_Entity;
86 Source : in String := GNAT.Source_Info.Source_Location)
87 return Object is (Function_Trace (Name => Entity & ':' & Source));
88
89 ---
90 -- Functrace is not quite as usefull as the C++ version. The reason are the missing constructors and destructors in
91 -- Ada. With Controlled types you can't limit to just one call to Initialize and one to Finalize There are allways
92 -- some extra Adjust with matching. Finalize.
93 --
94 -- Name of the function calls to be traced.
95 --
96 --: function Function_Trace (
97 --: Entity : in String;
98 --: Parameter : in Parameter_Vector.Vector)
99 --: return Object
100 --: is (Function_Trace (Entity & ':' & Parameter.Image));
101
102 ---
103 --
104 --: @param Name Name of the function calls to be traced.
105 --
106 procedure Entering (Name : in String) with
107 Inline;
108
109 ---
110 --
111 --: @param Entity Name of the function calls to be traced.
112 --: @param Source Source Line to be traced
113 --
114 procedure Entering
115 (Entity : in String := GNAT.Source_Info.Enclosing_Entity;
116 Source : in String := GNAT.Source_Info.Source_Location);
117
118 ---
119 --
120 --: @param Entity Name of the function calls to be traced.
121 --: @param Source Source Line to be traced
122 --
123 procedure Entering
124 (In_Parameter : in String;
125 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
126 Source : in String := GNAT.Source_Info.Source_Location);
127
128 ---
129 --
130 --: @param Entity Name of the function calls to be traced.
131 --: @param Source Source Line to be traced
132 --
133 procedure Entering
134 (In_Parameters : in Parameter_Vectors.Vector;
135 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
136 Source : in String := GNAT.Source_Info.Source_Location);
137
138 ---
139 --
140 --: @param Name Name of the function calls to be traced.
141 --
142 procedure Exiting (Name : in String) with
143 Inline;
144
145 ---
146 --
147 --: @param Entity Name of the function calls to be traced.
148 --: @param Source Source Line to be traced
149 --
150 procedure Exiting
151 (Entity : in String := GNAT.Source_Info.Enclosing_Entity;
152 Source : in String := GNAT.Source_Info.Source_Location);
153
154 ---
155 --
156 --: @param Out_Parameter return value of function as string.
157 --: @param Entity name of the function calls to be traced.
158 --: @param Source source line to be traced
159 --
160 procedure Exiting
161 (Out_Parameter : in String;
162 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
163 Source : in String := GNAT.Source_Info.Source_Location);
164
165 ---
166 --
167 --: @param Out_Parameters return value of function as string.
168 --: @param Entity name of the function calls to be traced.
169 --: @param Source source line to be traced
170 --
171 procedure Exiting
172 (Out_Parameters : in Parameter_Vectors.Vector;
173 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
174 Source : in String := GNAT.Source_Info.Source_Location);
175
176 ---
177 -- Trace the given exeption details and then raise the exception.
178 --
179 --: @param Raising Exeption which is raised Message : Free form Message
180 --: @param Message Message to print to trace
181 --: @param Entity Location destriptor.
182 --: @param Source Location destriptor.
183 procedure Raise_Exception_With_Entity
184 (Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity;
185 Message : in String := "No Message given";
186 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
187 Source : in String := GNAT.Source_Info.Source_Location) with
188 No_Return;
189
190 ---
191 -- Trace the given exeption details and then raise the exception.
192 --
193 --: @param Raising Exeption which is raised Message : Free form Message
194 --: @param Message Message to print to trace
195 --: @param Source Filename.
196 --: @param Line Line number.
197 procedure Raise_Exception_With_File
198 (Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity;
199 Message : in String := "No Message given";
200 Source : in String := GNAT.Source_Info.File;
201 Line : in Natural := GNAT.Source_Info.Line) with
202 No_Return;
203
204 ---
205 -- Trace the given exeption details and then raise the exception.
206 --
207 --: @param Raising Exeption which is raised Message : Free form Message
208 --: @param Message Message to print to trace
209 --: @param Entity Location destriptor.
210 --: @param Source Location destriptor.
211 procedure Raise_Exception_With_Entity
212 (Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity;
213 Message : in Wide_Wide_String := "No Message given";
214 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
215 Source : in String := GNAT.Source_Info.Source_Location) with
216 No_Return;
217
218 ---
219 -- Trace the given exeption details and then raise the exception.
220 --
221 --: @param Raising Exeption which is raised Message : Free form Message
222 --: @param Message Message to print to trace
223 --: @param Source Filename.
224 --: @param Line Line number.
225 procedure Raise_Exception_With_File
226 (Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity;
227 Message : in Wide_Wide_String := "No Message given";
228 Source : in String := GNAT.Source_Info.File;
229 Line : in Natural := GNAT.Source_Info.Line) with
230 No_Return;
231
232 ---
233 -- Report an assert condition. If the condition is not true create a trace entry describing the assertion and then
234 -- raise an exception.
235 --
236 --: @param Condition Condition which should be true
237 --: @param Raising Exeption which is raised
238 --: @param Message Free form Message
239 --: @param Entity Location destriptor.
240 --: @param Source Location destriptor.
241 procedure Report_Assertion
242 (Condition : in Boolean;
243 Raising : in Ada.Exceptions.Exception_Id := Ada.Assertions.Assertion_Error'Identity;
244 Message : in String := "No Message given.";
245 Entity : in String := GNAT.Source_Info.Enclosing_Entity;
246 Source : in String := GNAT.Source_Info.Source_Location) with
247 Inline;
248
249 ---
250 -- Report an assert condition. If the condition is not true create a trace entry describing the assertion and then
251 -- raise an exception.
252 --
253 -- This version used parameter which are compatible with AUnit
254 --
255 --: @param Condition Condition which should be true
256 --: @param Message Free form Message
257 --: @param Source Filename of source code
258 --: @param Line Line number in source code.
259 procedure Report_Assertion
260 (Condition : Boolean;
261 Message : String;
262 Source : String := GNAT.Source_Info.File;
263 Line : Natural := GNAT.Source_Info.Line);
264
265 ---
266 -- Write Line numbers
267 --
268 procedure Enable_Write_Line_Number with
269 Inline;
270
271 ---
272 -- Don't Write Line numbers
273 --
274 procedure Disable_Write_Line_Number with
275 Inline;
276
277 ---
278 -- check if Line numbers are written
279 --
280 function Is_Write_Line_Number_Enabled return Boolean with
281 Inline;
282
283 ---
284 -- Enable Trace
285 --
286 procedure Enable_Trace with
287 Inline;
288
289 ---
290 -- Enable Trace
291 --
292 procedure Disable_Trace with
293 Inline;
294
295 ---
296 -- check is trace is Enabled
297 --
298 function Is_Trace_Enabled return Boolean with
299 Inline;
300
301 ---
302 -- Enable Verbose Output
303 --
304 procedure Enable_Verbose with
305 Inline;
306
307 ---
308 -- Disable Verbose Output
309 --
310 procedure Disable_Verbose with
311 Inline;
312
313 ---
314 -- check is trace is Enabled
315 --
316 function Is_Verbose_Enabled return Boolean with
317 Inline;
318
319 ---
320 -- Write to queue - not supported yet.
321 --
322 procedure Write_To_Queue with
323 Inline;
324
325 ---
326 -- Write to Standart Error
327 --
328 procedure Write_To_Standard_Error with
329 Inline;
330
331 ---
332 -- Write to Standart Error
333 --
334 procedure Write_To_Standard_Output with
335 Inline;
336
337 ---
338 -- Write to queue - not supported yet.
339 --
340 procedure Write_To_File with
341 Inline;
342
343 ---
344 -- Set Filename for Trace File
345 --
346 procedure Write_To_File (New_Filename : in String);
347
348 ---
349 -- Check the Trace Destination
350 --
351 function Trace_Destination return Destination with
352 Inline;
353
354 ---
355 -- Enable the write prefix
356 --
357 procedure Enable_Write_Prefix with
358 Inline;
359
360 ---
361 -- Disable_ the write prefix
362 --
363 procedure Disable_Write_Prefix with
364 Inline;
365
366 ---
367 -- Check the write prefix flag
368 --
369 function Is_Write_Prefix_Enabled return Boolean with
370 Inline;
371
372 ---
373 -- Write an String using writeFormattedString after adding the appropriate padding for indentation.
374 --
375 --: @param Text String to be written
376 procedure Write (Text : in String);
377
378 ---
379 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
380 --
381 --: @param Text String to be written
382 procedure Write_Wide (Text : in Wide_String);
383
384 ---
385 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
386 --
387 --: @param Text String to be written
388 procedure Write_Wide_Wide (Text : in Wide_Wide_String);
389
390 ---
391 -- Write an String using writeFormattedString after adding the appropriate padding for indentation.
392 --
393 --: @param Text String to be written
394 procedure Write (Text : in Ada.Strings.Unbounded.Unbounded_String);
395
396 ---
397 -- Write an String using writeFormattedString after adding the appropriate padding for indentation.
398 --
399 --: @param Text String to be written
400 procedure Write (Text : in Ada.Strings.Wide_Unbounded.Unbounded_Wide_String);
401
402 ---
403 -- Write an String using writeFormattedString after adding the appropriate padding for indentation.
404 --
405 --: @param Text String to be written
406 procedure Write (Text : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);
407
408 ---
409 -- Write an Address.
410 --
411 --: @param Text String to be written
412 procedure Write (Text : in String; An_Address : in System.Address);
413
414 ---
415 -- Write an Exception to the Trace
416 --
417 --: @param An_Exception String to be written
418 procedure Write (An_Exception : in Ada.Exceptions.Exception_Occurrence);
419
420 ---
421 -- Write an Exception to the Trace
422 --
423 --: @param An_Exception Exception to be written
424 --: @param Entity Procedure in which the exception was caught
425 --: @param Source Source File in which Entity is located.
426 procedure Write
427 (An_Exception : in Ada.Exceptions.Exception_Occurrence;
428 Entity : in String;
429 Source : in String);
430
431 ---
432 -- Create a memory dump, S
433 --
434 --: @param An_Address String to be written
435 --: @param Size_In_Byte Size in Storage_Elements.
436 procedure Write_Dump (An_Address : in System.Address; Size_In_Byte : in System.Storage_Elements.Storage_Count);
437
438 ---
439 -- Create a memory dump. This Dump takes size in bits.
440 --
441 --: @param An_Address String to be written
442 --: @param Size_In_Bits Size in Bits - i.E. for 'Size.
443 procedure Write_Dump (An_Address : in System.Address; Size_In_Bits : in Integer);
444
445 ---
446 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
447 --
448 --: @param Text String to be written
449 procedure Write_Error (Text : in String);
450
451 ---
452 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
453 --
454 --: @param Text String to be written
455 procedure Write_Error (Text : in Wide_String);
456
457 ---
458 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
459 --
460 --: @param Text String to be written
461 procedure Write_Error (Text : in Wide_Wide_String);
462
463 ---
464 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
465 --
466 --: @param Text String to be written
467 procedure Write_Error (Text : in Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String);
468
469 ---
470 -- Write an Exception to the Trace
471 --
472 --: @param An_Exception String to be written
473 procedure Write_Error (An_Exception : in Ada.Exceptions.Exception_Occurrence);
474
475 ---
476 -- Write an Exception to the Trace
477 --
478 --: @param An_Exception String to be written
479 --: @param Entity Procedure in which the exception was caught
480 --: @param Source Source File in which Entity is located.
481 procedure Write_Error
482 (An_Exception : in Ada.Exceptions.Exception_Occurrence;
483 Entity : in String;
484 Source : in String);
485
486 ---
487 -- When verbose is aktivated then an empty line is written to Standart_Output
488 --
489 procedure Write_Info;
490
491 ---
492 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
493 --
494 -- When verbose is aktivated then the string is written to Standart_Output as well.
495 --
496 --: @param Text String to be written
497 procedure Write_Info (Text : in String);
498
499 ---
500 -- When verbose is aktivated then the character is written to Standart_Output.
501 --
502 --: @param Text character to be written
503 procedure Write_Info (Text : in Character);
504
505 ---
506 -- Write an IString using writeFormattedString after adding the appropriate padding for indentation.
507 --
508 -- When verbose is aktivated then the string is written to Standart_Output as well.
509 --
510 --: @param Text String to be written
511 procedure Write_Info (Text : in Ada.Strings.Unbounded.Unbounded_String);
512
513 ---
514 -- Write Help for Commandline Options parsed from Trace
515 --
516 procedure Write_Commandline_Help;
517
518private
519
520 ---
521 -- Ada Class Library
522 -- Trace
523 --
524 -- Instanz Data
525 --
526 --: @field Name_Length Length of trace String
527 --: @field Trace_Name Trace String
528 --
529 type Object (Name_Length : Positive) is new AdaCL.Base.Object with record
530 Trace_Name : String (1 .. Name_Length);
531 end record;
532
533 ---
534 -- Trace Copy.
535 --
536 --: @param This Object itself.
537 --
538 overriding procedure Adjust (This : in out Object);
539
540 ---
541 -- Trace end of function
542 --
543 --: @param This Object itself.
544 --
545 overriding procedure Finalize (This : in out Object);
546
547end AdaCL.Trace;
548
549---------------------------------------------------------------- {{{ ----------
550--: vim: set textwidth=0 nowrap tabstop=8 shiftwidth=3 softtabstop=3 expandtab :
551--: vim: set filetype=ada fileencoding=utf-8 fileformat=unix foldmethod=expr :
552--: vim: set spell spelllang=en_gb