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
228
229
230
231
232
233
234
235 | ------------------------------------------------------------------------------
-- File: Dual_IO.ads
-- Description: Dual_IO : clones the Text_IO I/O functions towards
-- Standard I/O but also outputs these I/O to a log file.
--
-- NB: 1) Use Create_Log and Close_Log to create and close a log file.
-- 2) Generic Integer_IO, Float_IO, ... are of course also present.
-- 3) Only procedures for I/O to Standard device are kept, use the
-- genuine Text_IO for Files and String I/O.
--
--
-- Date/version: 7-Apr-2023; 2-Mar-2013; 2-Feb-2011; 4-Jul-2001
-- Author: G. de Montmollin
-- http://gautiersblog.blogspot.com/
------------------------------------------------------------------------------
with Ada.IO_Exceptions, Ada.Text_IO;
package Dual_IO is
subtype Count is Ada.Text_IO.Count;
subtype Positive_Count is Ada.Text_IO.Positive_Count;
Unbounded : constant Count := Ada.Text_IO.Unbounded;
subtype Field is Ada.Text_IO.Field;
subtype Number_Base is Ada.Text_IO.Number_Base;
subtype Type_Set is Ada.Text_IO.Type_Set;
-------------------------
-- Log file Management --
-------------------------
procedure Create_Log (Name : in String);
procedure Append_Log (Name : in String);
procedure Close_Log;
function Is_Log_Open return Boolean;
-- Close and reopen: have an up to date copy on file system
procedure Close_and_Append_Log;
-- Buffer control
procedure Flush;
--------------------------------------------
-- Specification of line and page lengths --
--------------------------------------------
procedure Set_Line_Length (To : in Count) renames Ada.Text_IO.Set_Line_Length;
procedure Set_Page_Length (To : in Count) renames Ada.Text_IO.Set_Page_Length;
function Line_Length return Count renames Ada.Text_IO.Line_Length;
function Page_Length return Count renames Ada.Text_IO.Page_Length;
------------------------------------
-- Column, Line, and Page Control --
------------------------------------
procedure New_Line (Spacing : in Positive_Count := 1);
procedure Skip_Line (Spacing : in Positive_Count := 1);
function End_Of_Line return Boolean renames Ada.Text_IO.End_Of_Line;
procedure New_Page;
procedure Skip_Page;
function End_Of_Page return Boolean renames Ada.Text_IO.End_Of_Page;
function End_Of_File return Boolean renames Ada.Text_IO.End_Of_File;
procedure Set_Col (To : in Positive_Count) renames Ada.Text_IO.Set_Col;
procedure Set_Line (To : in Positive_Count) renames Ada.Text_IO.Set_Line;
function Col return Positive_Count renames Ada.Text_IO.Col;
function Line return Positive_Count renames Ada.Text_IO.Line;
function Page return Positive_Count renames Ada.Text_IO.Page;
-----------------------------
-- Characters Input-Output --
-----------------------------
procedure Get (Item : out Character);
procedure Put (Item : in Character);
procedure Look_Ahead (Item : out Character;
Is_End_Of_Line : out Boolean)
renames Ada.Text_IO.Look_Ahead;
-- No echo -> not logged -> renames suffices
procedure Get_Immediate (Item : out Character)
renames Ada.Text_IO.Get_Immediate;
procedure Get_Immediate (Item : out Character;
Available : out Boolean)
renames Ada.Text_IO.Get_Immediate;
--------------------------
-- Strings Input-Output --
--------------------------
procedure Get (Item : out String);
procedure Put (Item : in String);
procedure Get_Line
(Item : out String;
Last : out Natural);
procedure Put_Line
(Item : in String);
-- Generic package for Input-Output of Integer Types
generic
type Num is range <>;
package Integer_IO is
Default_Width : Field := Num'Width;
Default_Base : Number_Base := 10;
procedure Get (Item : out Num;
Width : in Field := 0);
procedure Put (Item : in Num;
Width : in Field := Default_Width;
Base : in Number_Base := Default_Base);
end Integer_IO;
-- Generic package for Input-Output of Real Types
generic
type Num is digits <>;
package Float_IO is
Default_Fore : Field := 2;
Default_Aft : Field := Num'Digits - 1;
Default_Exp : Field := 3;
procedure Get (Item : out Num;
Width : in Field := 0);
procedure Put (Item : in Num;
Fore : in Field := Default_Fore;
Aft : in Field := Default_Aft;
Exp : in Field := Default_Exp);
end Float_IO;
generic
type Num is delta <>;
package Fixed_IO is
Default_Fore : Field := Num'Fore;
Default_Aft : Field := Num'Aft;
Default_Exp : Field := 0;
procedure Get (Item : out Num;
Width : in Field := 0);
procedure Put (Item : in Num;
Fore : in Field := Default_Fore;
Aft : in Field := Default_Aft;
Exp : in Field := Default_Exp);
end Fixed_IO;
-- Generic package for Input-Output of Decimal Types
generic
type Num is delta <> digits <>;
package Decimal_IO is
Default_Fore : Field := Num'Fore;
Default_Aft : Field := Num'Aft;
Default_Exp : Field := 0;
procedure Get
(Item : out Num;
Width : in Field := 0);
procedure Put
(Item : in Num;
Fore : in Field := Default_Fore;
Aft : in Field := Default_Aft;
Exp : in Field := Default_Exp);
end Decimal_IO;
-- Generic package for Input-Output of Modular Types
generic
type Num is mod <>;
package Modular_IO is
Default_Width : Field := Num'Width;
Default_Base : Number_Base := 10;
procedure Get
(Item : out Num;
Width : in Field := 0);
procedure Put
(Item : in Num;
Width : in Field := Default_Width;
Base : in Number_Base := Default_Base);
end Modular_IO;
-- Generic package for Input-Output of Enumeration Types
generic
type Enum is (<>);
package Enumeration_IO is
Default_Width : Field := 0;
Default_Setting : Type_Set := Ada.Text_IO.Upper_Case;
procedure Get (Item : out Enum);
procedure Put (Item : in Enum;
Width : in Field := Default_Width;
Set : in Type_Set := Default_Setting);
end Enumeration_IO;
-- Exceptions
Status_Error : exception renames Ada.IO_Exceptions.Status_Error;
Mode_Error : exception renames Ada.IO_Exceptions.Mode_Error;
Name_Error : exception renames Ada.IO_Exceptions.Name_Error;
Use_Error : exception renames Ada.IO_Exceptions.Use_Error;
Device_Error : exception renames Ada.IO_Exceptions.Device_Error;
End_Error : exception renames Ada.IO_Exceptions.End_Error;
Data_Error : exception renames Ada.IO_Exceptions.Data_Error;
Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error;
Log_not_open : exception;
Log_already_open : exception;
end Dual_IO;
|