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 | with Interfaces.C;
with Interfaces.C.Strings;
with Ada.Finalization;
with Agpl.Trace_Is;
with Ada.Exceptions;
with Ada.Tags; use Ada.Tags;
use Ada;
-- Root for logging facilities
-- By default, a console logger is created. If you don't want it, disable it
-- via the access that you can get with the function Console_Tracer
package Agpl.Trace is
pragma Preelaborate;
Enabled : Boolean renames Trace_Is.Enabled;
-- Inlining shall cause no calls when this is false.
-- I have tested this; if this doesn't work something has gone wrong.
Master_Switch : constant Boolean := False;
-- when this is true, *EVERYTHING* will be traced.
-- This object is not thread safe.
-- type Object is limited interface;
type Object is abstract tagged limited private; -- null record;
-- Should be an interface but the gnat bug with containers prevents it
type Object_Access is access all Object'Class;
pragma Preelaborable_Initialization (Object);
type Levels is (Never,
Debug,
Informative,
Warning,
-- From here up, always logged even if section not enabled
Error,
Always);
for Levels use (Never => 0,
Debug => 1,
Informative => 2,
Warning => 3,
Error => 4,
Always => 5);
subtype All_Levels is Levels range Never .. Always;
subtype Warning_levels is All_Levels range Debug .. Error;
type Decorator is access function (Text : in String;
Level : in Levels;
Section : in String) return String;
Null_Object : constant Object_Access := null;
procedure Enable_Section (This : in out Object;
Section : in String;
Enabled : in Boolean := True)
is abstract;
procedure Enable_Section (This : in out Object;
Section : String;
Level : All_Levels) is abstract;
-- Section has its own level definition
procedure Log
(This : in out Object;
Text : in String;
Level : in Levels;
Section : in String := "") is abstract;
procedure Log
(This : in Object_Access;
Text : in String;
Level : in Levels;
Section : in String := "");
-- In purpose, This can be null to allow the passing of Null_Object.
-- This call *is* thread safe
pragma Inline (Log);
procedure Set_Level (This : in out Object; Level : in All_Levels)
is abstract;
-- Minimum for a message to be logged.
procedure Set_Active (This : in out Object; Active : in Boolean := True)
is abstract;
procedure Set_Decorator (This : in out Object; Decor : in Decorator)
is abstract;
function Decorate (This : in Object;
Text : in String;
Level : in Levels;
Section : in String) return String
is abstract;
-- Apply the decorator.
function Must_Log (This : in Object;
Level : in Levels;
Section : in String) return Boolean
is abstract;
procedure Log
(Text : in String;
Level : in Levels;
Section : in String := "");
-- This call *Is* thread safe.
pragma Inline (Log);
function Would_Log (Level : Levels; Section : String := "") return Boolean;
-- Says if some tracer would log with this setup.
-- Allows to know in advance if some trace should be prepared
procedure Add_Tracer (This : not null Object_Access);
-- Add a tracer that will be used for all traces.
-- Call not thread safe.
procedure Enable_Section (Section : in String; Enabled : in Boolean := True);
-- Apply to all tracers registered.
procedure Enable_Section (Section : String;
Level : All_Levels);
procedure Set_Decorator (Decor : in Decorator);
-- Apply to all tracers registered.
procedure Set_Level (Level : in All_Levels);
-- Apply to all tracers registered.
function Console_Tracer return Object_Access;
-- Reference to the default tracer.
-- Exception helpers:
function External_Tag (Tag : in Ada.Tags.Tag) return String renames
Ada.Tags.External_Tag;
function Report (E : Ada.Exceptions.Exception_Occurrence) return String;
type String_Access is access all String;
type Logger (Text : String_Access;
Level : Levels) is new Ada.Finalization.Limited_Controlled
with null record;
-- Used to log inline in declarative blocks...
private
overriding
procedure Initialize (This : in out Logger);
-- C helpers
procedure C_Log (Text : Interfaces.C.Strings.Chars_Ptr;
Level : Interfaces.C.Int;
Section : Interfaces.C.Strings.Chars_Ptr);
pragma Export (C, C_Log, "agpl__trace__log");
type Object is abstract tagged limited null record;
end Agpl.Trace;
|