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 | -- -----------------------------------------------------------------------------
-- bbt, the black box tester (https://github.com/LionelDraghi/bbt)
-- Author : Lionel Draghi
-- SPDX-License-Identifier: APSL-2.0
-- SPDX-FileCopyrightText: 2024, Lionel Draghi
-- -----------------------------------------------------------------------------
with Ada.Strings.Text_Buffers;
with Ada.Strings.Unbounded;
with Ada.Text_IO; use Ada.Text_IO;
with Ada.Calendar;
private package BBT.IO is
-- --------------------------------------------------------------------------
type Verbosity_Levels is (Quiet, Normal, Verbose, Debug);
-- NB : order is significant, X is more verbose thant X'Pred!
-- Default: Normal messages are displayed, verbose messages are not
-- displayed.
-- Quiet: Neither normal messages nor verbose messages are displayed.
-- This mode can be achieved using option --quiet.
-- Verbose: Both normal messages and verbose messages are displayed.
-- This mode can be achieved using option --verbose.
function Is_Authorized (Verbosity : Verbosity_Levels) return Boolean;
-- return True if Verbosity is >= to current setting.
function Current_Verbosity return Verbosity_Levels;
procedure Set_Verbosity (To : Verbosity_Levels);
function Debug_Mode return Boolean is (Current_Verbosity = Debug);
function Verbose_Mode return Boolean is (Current_Verbosity = Verbose);
function Normal_Mode return Boolean is (Current_Verbosity = Normal);
function Quiet_Mode return Boolean is (Current_Verbosity = Quiet);
-- --------------------------------------------------------------------------
-- Observability! (kind of a tentative of...)
type Extended_Topics is (None,
Spawn,
Lexer,
BBT_Files,
Tests_Builder,
Step_Lexer,
Runner);
subtype Topics is Extended_Topics range
Extended_Topics'Succ (None) .. Extended_Topics'Last;
-- None is the default parameter for IO operation, but is not in Topics
-- range, used when setting what should be printed.
procedure Enable_Topic (Topic : Topics);
function Is_Enabled (Topic : Extended_Topics) return Boolean;
-- return always false for None
-- --------------------------------------------------------------------------
type Location_Type is private with Put_Image => Location_GNU_Image;
procedure Location_GNU_Image
(Output : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class;
Value : Location_Type);
No_Location : constant Location_Type;
function File (Loc : Location_Type) return String;
function Line (Loc : Location_Type) return Ada.Text_IO.Count;
function Column (Loc : Location_Type) return Ada.Text_IO.Count;
-- --------------------------------------------------------------------------
function Image (Loc : Location_Type) return String;
-- Purpose:
-- returns a source/line/column prefix to messages compatible with
-- GNU Standard "sourcefile:lineno:column: message" format.
-- (refer to <https://www.gnu.org/prep/standards/html_node/Errors.html>),
--
-- That is :
-- > "sourcefile:lineno:"
-- if column = 0 or 1,
-- or
-- > "sourcefile:lineno.column:"
-- otherwise.
-- --------------------------------------------------------------------------
function Location (Name : String;
Line : Ada.Text_IO.Count;
Column : Ada.Text_IO.Count := 0) return Location_Type;
-- When manual adjustment is needed.
function Location (File : Ada.Text_IO.File_Type) return Location_Type;
-- Automatic Line/Col through Text_IO calls
-- --------------------------------------------------------------------------
procedure Set_Reference_Directory (Dir_Name : String);
-- Register a path that will be removed from Image, to avoid long absolute
-- Paths.
-- --------------------------------------------------------------------------
-- Mimics eponym Text_IO functions, except that :
-- - if --quiet is set on command line, they have no effect,
-- unless Even_In_Quiet_Mode is set.
-- - if Only_When_Verbose is False, they have no effect
-- unless --verbose is set on command line.
-- - if a Topic is given, and this topic is enable, previous parameter
-- are ignored and the Item is printed.
procedure Put_Line (Item : String;
File : String := "";
Line : Ada.Text_IO.Count;
Verbosity : Verbosity_Levels := Normal;
Topic : Extended_Topics := None);
procedure Put (Item : String;
File : String := "";
Line : Ada.Text_IO.Count;
Verbosity : Verbosity_Levels := Normal;
Topic : Extended_Topics := None);
procedure New_Line (Verbosity : Verbosity_Levels := Normal;
Topic : Extended_Topics := None);
procedure Put_Line (Item : String;
Location : Location_Type := No_Location;
Verbosity : Verbosity_Levels := Normal;
Topic : Extended_Topics := None);
procedure Put (Item : String;
Location : Location_Type := No_Location;
Verbosity : Verbosity_Levels := Normal;
Topic : Extended_Topics := None);
-- --------------------------------------------------------------------------
procedure Put_Warning (Msg : String;
File : String := "";
Line : Ada.Text_IO.Count := 0);
procedure Put_Error (Msg : String;
File : String := "";
Line : Ada.Text_IO.Count := 0);
procedure Put_Exception (Msg : String;
File : String := "";
Line : Ada.Text_IO.Count := 0);
procedure Put_Warning (Msg : String;
Location : Location_Type);
procedure Put_Error (Msg : String;
Location : Location_Type);
procedure Put_Exception (Msg : String;
Location : Location_Type);
-- --------------------------------------------------------------------------
procedure Enable_Tee (File_Name : String;
Verbosity : Verbosity_Levels := Normal);
-- Enable the duplication af all Put/Put_Line/etc. in a file.
-- The Verbosity may be different for standard output and for the file.
-- This is a simple way to have (for example) a terse standard output,
-- and a verbose log file.
procedure Pause_Tee;
-- Store the current state and pause Tee.
procedure Restore_Tee;
-- Restore the state before last Pause_Tee call.
-- --------------------------------------------------------------------------
-- Error_Count and Warning_Count return the number of call to Put_Error
-- and Put_Warning.
function Error_Count return Natural;
function Warning_Count return Natural;
-- --------------------------------------------------------------------------
-- Some_Error return True if some error occurred, or if some Warning
-- occurred and option to treat warning as error is set.
function Some_Error return Boolean;
-- --------------------------------------------------------------------------
function Image (Time : Ada.Calendar.Time) return String;
-- To ensure common options to call to Ada.Calendar.Formatting.Image,
-- that is:
-- 1. Include_Time_Fraction => True,
-- to get hundredths of a second printed in the hope that
-- it will be useful in future version, or on other OSes.
-- 2. Time_Zone => Ada.Calendar.Time_Zones.UTC_Time_Offset
-- to get the same file time tag printed in local time that the user
-- would see by making a simple ls -l
-- --------------------------------------------------------------------------
use Ada.Strings.Unbounded;
type File_Name is new Unbounded_String;
function "+" (Name : File_Name) return String is (To_String (Name));
function "+" (Name : String) return File_Name is
(File_Name'(To_Unbounded_String (Name)));
No_Name : constant File_Name := +"";
private
type Location_Type is record
File : File_Name := No_Name;
Line : Ada.Text_IO.Count := 1;
Column : Ada.Text_IO.Count := 0;
end record;
No_Location : constant Location_Type := (No_Name, 1, 0);
end BBT.IO;
|