|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNAT RUN-TIME COMPONENTS --
|
|
|
4 -- --
|
|
|
5 -- A D A . T E X T _ I O --
|
|
|
6 -- --
|
|
|
7 -- S p e c --
|
|
|
8 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
11 -- This specification is derived from the Ada Reference Manual for use with --
|
|
|
12 -- GNAT. The copyright notice above, and the license provisions that follow --
|
|
|
13 -- apply solely to the contents of the part following the private keyword. --
|
|
|
14 -- --
|
|
|
15 -- GNAT is free software; you can redistribute it and/or modify it under --
|
|
|
16 -- terms of the GNU General Public License as published by the Free Soft- --
|
|
|
17 -- ware Foundation; either version 3, or (at your option) any later ver- --
|
|
|
18 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
|
|
|
19 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
|
|
|
20 -- or FITNESS FOR A PARTICULAR PURPOSE. --
|
|
|
21 -- --
|
|
|
22 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
23 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
24 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
25 -- --
|
|
|
26 -- You should have received a copy of the GNU General Public License and --
|
|
|
27 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
28 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
29 -- <http://www.gnu.org/licenses/>. --
|
|
|
30 -- --
|
|
|
31 -- GNAT was originally developed by the GNAT team at New York University. --
|
|
|
32 -- Extensive contributions were provided by Ada Core Technologies Inc. --
|
|
|
33 -- --
|
|
|
34 ------------------------------------------------------------------------------
|
|
|
35
|
|
145
|
36 -- Preconditions in this unit are meant for analysis only, not for run-time
|
|
|
37 -- checking, so that the expected exceptions are raised. This is enforced by
|
|
|
38 -- setting the corresponding assertion policy to Ignore. These preconditions
|
|
|
39 -- are partial and protect against Status_Error, Mode_Error, and Layout_Error,
|
|
|
40 -- but not against other types of errors.
|
|
|
41
|
|
|
42 pragma Assertion_Policy (Pre => Ignore);
|
|
|
43
|
|
111
|
44 -- Note: the generic subpackages of Text_IO (Integer_IO, Float_IO, Fixed_IO,
|
|
|
45 -- Modular_IO, Decimal_IO and Enumeration_IO) appear as private children in
|
|
|
46 -- GNAT. These children are with'ed automatically if they are referenced, so
|
|
|
47 -- this rearrangement is invisible to user programs, but has the advantage
|
|
|
48 -- that only the needed parts of Text_IO are processed and loaded.
|
|
|
49
|
|
|
50 with Ada.IO_Exceptions;
|
|
|
51 with Ada.Streams;
|
|
|
52
|
|
|
53 with System;
|
|
|
54 with System.File_Control_Block;
|
|
|
55 with System.WCh_Con;
|
|
|
56
|
|
145
|
57 package Ada.Text_IO with
|
|
|
58 Abstract_State => (File_System),
|
|
|
59 Initializes => (File_System),
|
|
|
60 Initial_Condition => Line_Length = 0 and Page_Length = 0
|
|
|
61 is
|
|
111
|
62 pragma Elaborate_Body;
|
|
|
63
|
|
145
|
64 type File_Type is limited private with
|
|
|
65 Default_Initial_Condition => (not Is_Open (File_Type));
|
|
111
|
66 type File_Mode is (In_File, Out_File, Append_File);
|
|
|
67
|
|
|
68 -- The following representation clause allows the use of unchecked
|
|
|
69 -- conversion for rapid translation between the File_Mode type
|
|
|
70 -- used in this package and System.File_IO.
|
|
|
71
|
|
|
72 for File_Mode use
|
|
|
73 (In_File => 0, -- System.FIle_IO.File_Mode'Pos (In_File)
|
|
|
74 Out_File => 2, -- System.File_IO.File_Mode'Pos (Out_File)
|
|
|
75 Append_File => 3); -- System.File_IO.File_Mode'Pos (Append_File)
|
|
|
76
|
|
|
77 type Count is range 0 .. Natural'Last;
|
|
|
78 -- The value of Count'Last must be large enough so that the assumption that
|
|
|
79 -- the Line, Column and Page counts can never exceed this value is valid.
|
|
|
80
|
|
|
81 subtype Positive_Count is Count range 1 .. Count'Last;
|
|
|
82
|
|
|
83 Unbounded : constant Count := 0;
|
|
|
84 -- Line and page length
|
|
|
85
|
|
|
86 subtype Field is Integer range 0 .. 255;
|
|
|
87 -- Note: if for any reason, there is a need to increase this value, then it
|
|
|
88 -- will be necessary to change the corresponding value in System.Img_Real
|
|
|
89 -- in file s-imgrea.adb.
|
|
|
90
|
|
|
91 subtype Number_Base is Integer range 2 .. 16;
|
|
|
92
|
|
|
93 type Type_Set is (Lower_Case, Upper_Case);
|
|
|
94
|
|
|
95 ---------------------
|
|
|
96 -- File Management --
|
|
|
97 ---------------------
|
|
|
98
|
|
|
99 procedure Create
|
|
|
100 (File : in out File_Type;
|
|
|
101 Mode : File_Mode := Out_File;
|
|
|
102 Name : String := "";
|
|
145
|
103 Form : String := "")
|
|
|
104 with
|
|
|
105 Pre => not Is_Open (File),
|
|
|
106 Post =>
|
|
|
107 Is_Open (File)
|
|
|
108 and then Ada.Text_IO.Mode (File) = Mode
|
|
|
109 and then (if Mode /= In_File
|
|
|
110 then (Line_Length (File) = 0
|
|
|
111 and then Page_Length (File) = 0)),
|
|
|
112 Global => (In_Out => File_System);
|
|
111
|
113
|
|
|
114 procedure Open
|
|
|
115 (File : in out File_Type;
|
|
|
116 Mode : File_Mode;
|
|
|
117 Name : String;
|
|
145
|
118 Form : String := "")
|
|
|
119 with
|
|
|
120 Pre => not Is_Open (File),
|
|
|
121 Post =>
|
|
|
122 Is_Open (File)
|
|
|
123 and then Ada.Text_IO.Mode (File) = Mode
|
|
|
124 and then (if Mode /= In_File
|
|
|
125 then (Line_Length (File) = 0
|
|
|
126 and then Page_Length (File) = 0)),
|
|
|
127 Global => (In_Out => File_System);
|
|
111
|
128
|
|
145
|
129 procedure Close (File : in out File_Type) with
|
|
|
130 Pre => Is_Open (File),
|
|
|
131 Post => not Is_Open (File),
|
|
|
132 Global => (In_Out => File_System);
|
|
|
133 procedure Delete (File : in out File_Type) with
|
|
|
134 Pre => Is_Open (File),
|
|
|
135 Post => not Is_Open (File),
|
|
|
136 Global => (In_Out => File_System);
|
|
|
137 procedure Reset (File : in out File_Type; Mode : File_Mode) with
|
|
|
138 Pre => Is_Open (File),
|
|
|
139 Post =>
|
|
|
140 Is_Open (File)
|
|
|
141 and then Ada.Text_IO.Mode (File) = Mode
|
|
|
142 and then (if Mode /= In_File
|
|
|
143 then (Line_Length (File) = 0
|
|
|
144 and then Page_Length (File) = 0)),
|
|
|
145 Global => (In_Out => File_System);
|
|
|
146 procedure Reset (File : in out File_Type) with
|
|
|
147 Pre => Is_Open (File),
|
|
|
148 Post =>
|
|
|
149 Is_Open (File)
|
|
|
150 and Mode (File)'Old = Mode (File)
|
|
|
151 and (if Mode (File) /= In_File
|
|
|
152 then (Line_Length (File) = 0
|
|
|
153 and then Page_Length (File) = 0)),
|
|
|
154 Global => (In_Out => File_System);
|
|
111
|
155
|
|
145
|
156 function Mode (File : File_Type) return File_Mode with
|
|
|
157 Pre => Is_Open (File),
|
|
|
158 Global => null;
|
|
|
159 function Name (File : File_Type) return String with
|
|
|
160 Pre => Is_Open (File),
|
|
|
161 Global => null;
|
|
|
162 function Form (File : File_Type) return String with
|
|
|
163 Pre => Is_Open (File),
|
|
|
164 Global => null;
|
|
111
|
165
|
|
145
|
166 function Is_Open (File : File_Type) return Boolean with
|
|
|
167 Global => null;
|
|
111
|
168
|
|
|
169 ------------------------------------------------------
|
|
|
170 -- Control of default input, output and error files --
|
|
|
171 ------------------------------------------------------
|
|
|
172
|
|
145
|
173 procedure Set_Input (File : File_Type) with SPARK_Mode => Off;
|
|
|
174 procedure Set_Output (File : File_Type) with SPARK_Mode => Off;
|
|
|
175 procedure Set_Error (File : File_Type) with SPARK_Mode => Off;
|
|
111
|
176
|
|
145
|
177 function Standard_Input return File_Type with SPARK_Mode => Off;
|
|
|
178 function Standard_Output return File_Type with SPARK_Mode => Off;
|
|
|
179 function Standard_Error return File_Type with SPARK_Mode => Off;
|
|
111
|
180
|
|
145
|
181 function Current_Input return File_Type with SPARK_Mode => Off;
|
|
|
182 function Current_Output return File_Type with SPARK_Mode => Off;
|
|
|
183 function Current_Error return File_Type with SPARK_Mode => Off;
|
|
111
|
184
|
|
|
185 type File_Access is access constant File_Type;
|
|
|
186
|
|
145
|
187 function Standard_Input return File_Access with SPARK_Mode => Off;
|
|
|
188 function Standard_Output return File_Access with SPARK_Mode => Off;
|
|
|
189 function Standard_Error return File_Access with SPARK_Mode => Off;
|
|
111
|
190
|
|
145
|
191 function Current_Input return File_Access with SPARK_Mode => Off;
|
|
|
192 function Current_Output return File_Access with SPARK_Mode => Off;
|
|
|
193 function Current_Error return File_Access with SPARK_Mode => Off;
|
|
111
|
194
|
|
|
195 --------------------
|
|
|
196 -- Buffer control --
|
|
|
197 --------------------
|
|
|
198
|
|
|
199 -- Note: The parameter file is IN OUT in the RM, but this is clearly
|
|
|
200 -- an oversight, and was intended to be IN, see AI95-00057.
|
|
|
201
|
|
145
|
202 procedure Flush (File : File_Type) with
|
|
|
203 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
204 Post =>
|
|
|
205 Line_Length (File)'Old = Line_Length (File)
|
|
|
206 and Page_Length (File)'Old = Page_Length (File),
|
|
|
207 Global => (In_Out => File_System);
|
|
|
208 procedure Flush with
|
|
|
209 Post =>
|
|
|
210 Line_Length'Old = Line_Length
|
|
|
211 and Page_Length'Old = Page_Length,
|
|
|
212 Global => (In_Out => File_System);
|
|
111
|
213
|
|
|
214 --------------------------------------------
|
|
|
215 -- Specification of line and page lengths --
|
|
|
216 --------------------------------------------
|
|
|
217
|
|
145
|
218 procedure Set_Line_Length (File : File_Type; To : Count) with
|
|
|
219 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
220 Post =>
|
|
|
221 Line_Length (File) = To
|
|
|
222 and Page_Length (File)'Old = Page_Length (File),
|
|
|
223 Global => (In_Out => File_System);
|
|
|
224 procedure Set_Line_Length (To : Count) with
|
|
|
225 Post =>
|
|
|
226 Line_Length = To
|
|
|
227 and Page_Length'Old = Page_Length,
|
|
|
228 Global => (In_Out => File_System);
|
|
111
|
229
|
|
145
|
230 procedure Set_Page_Length (File : File_Type; To : Count) with
|
|
|
231 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
232 Post =>
|
|
|
233 Page_Length (File) = To
|
|
|
234 and Line_Length (File)'Old = Line_Length (File),
|
|
|
235 Global => (In_Out => File_System);
|
|
|
236 procedure Set_Page_Length (To : Count) with
|
|
|
237 Post =>
|
|
|
238 Page_Length = To
|
|
|
239 and Line_Length'Old = Line_Length,
|
|
|
240 Global => (In_Out => File_System);
|
|
111
|
241
|
|
145
|
242 function Line_Length (File : File_Type) return Count with
|
|
|
243 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
244 Global => (Input => File_System);
|
|
|
245 function Line_Length return Count with
|
|
|
246 Global => (Input => File_System);
|
|
|
247
|
|
|
248 function Page_Length (File : File_Type) return Count with
|
|
|
249 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
250 Global => (Input => File_System);
|
|
|
251 function Page_Length return Count with
|
|
|
252 Global => (Input => File_System);
|
|
111
|
253
|
|
|
254 ------------------------------------
|
|
|
255 -- Column, Line, and Page Control --
|
|
|
256 ------------------------------------
|
|
|
257
|
|
145
|
258 procedure New_Line (File : File_Type; Spacing : Positive_Count := 1) with
|
|
|
259 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
260 Post =>
|
|
|
261 Line_Length (File)'Old = Line_Length (File)
|
|
|
262 and Page_Length (File)'Old = Page_Length (File),
|
|
|
263 Global => (In_Out => File_System);
|
|
|
264 procedure New_Line (Spacing : Positive_Count := 1) with
|
|
|
265 Post =>
|
|
|
266 Line_Length'Old = Line_Length
|
|
|
267 and Page_Length'Old = Page_Length,
|
|
|
268 Global => (In_Out => File_System);
|
|
111
|
269
|
|
145
|
270 procedure Skip_Line (File : File_Type; Spacing : Positive_Count := 1) with
|
|
|
271 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
272 Global => (In_Out => File_System);
|
|
|
273 procedure Skip_Line (Spacing : Positive_Count := 1) with
|
|
|
274 Post =>
|
|
|
275 Line_Length'Old = Line_Length
|
|
|
276 and Page_Length'Old = Page_Length,
|
|
|
277 Global => (In_Out => File_System);
|
|
111
|
278
|
|
145
|
279 function End_Of_Line (File : File_Type) return Boolean with
|
|
|
280 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
281 Global => (Input => File_System);
|
|
|
282 function End_Of_Line return Boolean with
|
|
|
283 Global => (Input => File_System);
|
|
111
|
284
|
|
145
|
285 procedure New_Page (File : File_Type) with
|
|
|
286 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
287 Post =>
|
|
|
288 Line_Length (File)'Old = Line_Length (File)
|
|
|
289 and Page_Length (File)'Old = Page_Length (File),
|
|
|
290 Global => (In_Out => File_System);
|
|
|
291 procedure New_Page with
|
|
|
292 Post =>
|
|
|
293 Line_Length'Old = Line_Length
|
|
|
294 and Page_Length'Old = Page_Length,
|
|
|
295 Global => (In_Out => File_System);
|
|
111
|
296
|
|
145
|
297 procedure Skip_Page (File : File_Type) with
|
|
|
298 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
299 Global => (In_Out => File_System);
|
|
|
300 procedure Skip_Page with
|
|
|
301 Post =>
|
|
|
302 Line_Length'Old = Line_Length
|
|
|
303 and Page_Length'Old = Page_Length,
|
|
|
304 Global => (In_Out => File_System);
|
|
111
|
305
|
|
145
|
306 function End_Of_Page (File : File_Type) return Boolean with
|
|
|
307 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
308 Global => (Input => File_System);
|
|
|
309 function End_Of_Page return Boolean with
|
|
|
310 Global => (Input => File_System);
|
|
111
|
311
|
|
145
|
312 function End_Of_File (File : File_Type) return Boolean with
|
|
|
313 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
314 Global => (Input => File_System);
|
|
|
315 function End_Of_File return Boolean with
|
|
|
316 Global => (Input => File_System);
|
|
111
|
317
|
|
145
|
318 procedure Set_Col (File : File_Type; To : Positive_Count) with
|
|
|
319 Pre =>
|
|
|
320 Is_Open (File)
|
|
|
321 and then (if Mode (File) /= In_File
|
|
|
322 then (Line_Length (File) = 0
|
|
|
323 or else To <= Line_Length (File))),
|
|
|
324 Contract_Cases =>
|
|
|
325 (Mode (File) /= In_File =>
|
|
|
326 Line_Length (File)'Old = Line_Length (File)
|
|
|
327 and Page_Length (File)'Old = Page_Length (File),
|
|
|
328 others => True),
|
|
|
329 Global => (In_Out => File_System);
|
|
|
330 procedure Set_Col (To : Positive_Count) with
|
|
|
331 Pre => Line_Length = 0 or To <= Line_Length,
|
|
|
332 Post =>
|
|
|
333 Line_Length'Old = Line_Length
|
|
|
334 and Page_Length'Old = Page_Length,
|
|
|
335 Global => (In_Out => File_System);
|
|
111
|
336
|
|
145
|
337 procedure Set_Line (File : File_Type; To : Positive_Count) with
|
|
|
338 Pre =>
|
|
|
339 Is_Open (File)
|
|
|
340 and then (if Mode (File) /= In_File
|
|
|
341 then (Page_Length (File) = 0
|
|
|
342 or else To <= Page_Length (File))),
|
|
|
343 Contract_Cases =>
|
|
|
344 (Mode (File) /= In_File =>
|
|
|
345 Line_Length (File)'Old = Line_Length (File)
|
|
|
346 and Page_Length (File)'Old = Page_Length (File),
|
|
|
347 others => True),
|
|
|
348 Global => (In_Out => File_System);
|
|
|
349 procedure Set_Line (To : Positive_Count) with
|
|
|
350 Pre => Page_Length = 0 or To <= Page_Length,
|
|
|
351 Post =>
|
|
|
352 Line_Length'Old = Line_Length
|
|
|
353 and Page_Length'Old = Page_Length,
|
|
|
354 Global => (In_Out => File_System);
|
|
111
|
355
|
|
145
|
356 function Col (File : File_Type) return Positive_Count with
|
|
|
357 Pre => Is_Open (File),
|
|
|
358 Global => (Input => File_System);
|
|
|
359 function Col return Positive_Count with
|
|
|
360 Global => (Input => File_System);
|
|
111
|
361
|
|
145
|
362 function Line (File : File_Type) return Positive_Count with
|
|
|
363 Pre => Is_Open (File),
|
|
|
364 Global => (Input => File_System);
|
|
|
365 function Line return Positive_Count with
|
|
|
366 Global => (Input => File_System);
|
|
|
367
|
|
|
368 function Page (File : File_Type) return Positive_Count with
|
|
|
369 Pre => Is_Open (File),
|
|
|
370 Global => (Input => File_System);
|
|
|
371 function Page return Positive_Count with
|
|
|
372 Global => (Input => File_System);
|
|
111
|
373
|
|
|
374 ----------------------------
|
|
|
375 -- Character Input-Output --
|
|
|
376 ----------------------------
|
|
|
377
|
|
145
|
378 procedure Get (File : File_Type; Item : out Character) with
|
|
|
379 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
380 Global => (In_Out => File_System);
|
|
|
381 procedure Get (Item : out Character) with
|
|
|
382 Post =>
|
|
|
383 Line_Length'Old = Line_Length
|
|
|
384 and Page_Length'Old = Page_Length,
|
|
|
385 Global => (In_Out => File_System);
|
|
|
386 procedure Put (File : File_Type; Item : Character) with
|
|
|
387 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
388 Post =>
|
|
|
389 Line_Length (File)'Old = Line_Length (File)
|
|
|
390 and Page_Length (File)'Old = Page_Length (File),
|
|
|
391 Global => (In_Out => File_System);
|
|
|
392 procedure Put (Item : Character) with
|
|
|
393 Post =>
|
|
|
394 Line_Length'Old = Line_Length
|
|
|
395 and Page_Length'Old = Page_Length,
|
|
|
396 Global => (In_Out => File_System);
|
|
111
|
397
|
|
|
398 procedure Look_Ahead
|
|
|
399 (File : File_Type;
|
|
|
400 Item : out Character;
|
|
145
|
401 End_Of_Line : out Boolean)
|
|
|
402 with
|
|
|
403 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
404 Global => (Input => File_System);
|
|
111
|
405
|
|
|
406 procedure Look_Ahead
|
|
|
407 (Item : out Character;
|
|
145
|
408 End_Of_Line : out Boolean)
|
|
|
409 with
|
|
|
410 Post =>
|
|
|
411 Line_Length'Old = Line_Length
|
|
|
412 and Page_Length'Old = Page_Length,
|
|
|
413 Global => (Input => File_System);
|
|
111
|
414
|
|
|
415 procedure Get_Immediate
|
|
|
416 (File : File_Type;
|
|
145
|
417 Item : out Character)
|
|
|
418 with
|
|
|
419 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
420 Global => (In_Out => File_System);
|
|
111
|
421
|
|
|
422 procedure Get_Immediate
|
|
145
|
423 (Item : out Character)
|
|
|
424 with
|
|
|
425 Post =>
|
|
|
426 Line_Length'Old = Line_Length
|
|
|
427 and Page_Length'Old = Page_Length,
|
|
|
428 Global => (In_Out => File_System);
|
|
111
|
429
|
|
|
430 procedure Get_Immediate
|
|
|
431 (File : File_Type;
|
|
|
432 Item : out Character;
|
|
145
|
433 Available : out Boolean)
|
|
|
434 with
|
|
|
435 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
436 Global => (In_Out => File_System);
|
|
111
|
437
|
|
|
438 procedure Get_Immediate
|
|
|
439 (Item : out Character;
|
|
145
|
440 Available : out Boolean)
|
|
|
441 with
|
|
|
442 Post =>
|
|
|
443 Line_Length'Old = Line_Length
|
|
|
444 and Page_Length'Old = Page_Length,
|
|
|
445 Global => (In_Out => File_System);
|
|
111
|
446
|
|
|
447 -------------------------
|
|
|
448 -- String Input-Output --
|
|
|
449 -------------------------
|
|
|
450
|
|
145
|
451 procedure Get (File : File_Type; Item : out String) with
|
|
|
452 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
453 Global => (In_Out => File_System);
|
|
|
454 procedure Get (Item : out String) with
|
|
|
455 Post =>
|
|
|
456 Line_Length'Old = Line_Length
|
|
|
457 and Page_Length'Old = Page_Length,
|
|
|
458 Global => (In_Out => File_System);
|
|
|
459 procedure Put (File : File_Type; Item : String) with
|
|
|
460 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
461 Post =>
|
|
|
462 Line_Length (File)'Old = Line_Length (File)
|
|
|
463 and Page_Length (File)'Old = Page_Length (File),
|
|
|
464 Global => (In_Out => File_System);
|
|
|
465 procedure Put (Item : String) with
|
|
|
466 Post =>
|
|
|
467 Line_Length'Old = Line_Length
|
|
|
468 and Page_Length'Old = Page_Length,
|
|
|
469 Global => (In_Out => File_System);
|
|
111
|
470
|
|
|
471 procedure Get_Line
|
|
|
472 (File : File_Type;
|
|
|
473 Item : out String;
|
|
145
|
474 Last : out Natural)
|
|
|
475 with
|
|
|
476 Pre => Is_Open (File) and then Mode (File) = In_File,
|
|
|
477 Post => (if Item'Length > 0 then Last in Item'First - 1 .. Item'Last
|
|
|
478 else Last = Item'First - 1),
|
|
|
479 Global => (In_Out => File_System);
|
|
111
|
480
|
|
|
481 procedure Get_Line
|
|
|
482 (Item : out String;
|
|
145
|
483 Last : out Natural)
|
|
|
484 with
|
|
|
485 Post =>
|
|
|
486 Line_Length'Old = Line_Length
|
|
|
487 and Page_Length'Old = Page_Length
|
|
|
488 and (if Item'Length > 0 then Last in Item'First - 1 .. Item'Last
|
|
|
489 else Last = Item'First - 1),
|
|
|
490 Global => (In_Out => File_System);
|
|
111
|
491
|
|
145
|
492 function Get_Line (File : File_Type) return String with SPARK_Mode => Off;
|
|
111
|
493 pragma Ada_05 (Get_Line);
|
|
|
494
|
|
145
|
495 function Get_Line return String with SPARK_Mode => Off;
|
|
111
|
496 pragma Ada_05 (Get_Line);
|
|
|
497
|
|
|
498 procedure Put_Line
|
|
|
499 (File : File_Type;
|
|
145
|
500 Item : String)
|
|
|
501 with
|
|
|
502 Pre => Is_Open (File) and then Mode (File) /= In_File,
|
|
|
503 Post =>
|
|
|
504 Line_Length (File)'Old = Line_Length (File)
|
|
|
505 and Page_Length (File)'Old = Page_Length (File),
|
|
|
506 Global => (In_Out => File_System);
|
|
111
|
507
|
|
|
508 procedure Put_Line
|
|
145
|
509 (Item : String)
|
|
|
510 with
|
|
|
511 Post =>
|
|
|
512 Line_Length'Old = Line_Length
|
|
|
513 and Page_Length'Old = Page_Length,
|
|
|
514 Global => (In_Out => File_System);
|
|
111
|
515
|
|
|
516 ---------------------------------------
|
|
|
517 -- Generic packages for Input-Output --
|
|
|
518 ---------------------------------------
|
|
|
519
|
|
|
520 -- The generic packages:
|
|
|
521
|
|
|
522 -- Ada.Text_IO.Integer_IO
|
|
|
523 -- Ada.Text_IO.Modular_IO
|
|
|
524 -- Ada.Text_IO.Float_IO
|
|
|
525 -- Ada.Text_IO.Fixed_IO
|
|
|
526 -- Ada.Text_IO.Decimal_IO
|
|
|
527 -- Ada.Text_IO.Enumeration_IO
|
|
|
528
|
|
|
529 -- are implemented as separate child packages in GNAT, so the
|
|
|
530 -- spec and body of these packages are to be found in separate
|
|
|
531 -- child units. This implementation detail is hidden from the
|
|
|
532 -- Ada programmer by special circuitry in the compiler that
|
|
|
533 -- treats these child packages as though they were nested in
|
|
|
534 -- Text_IO. The advantage of this special processing is that
|
|
|
535 -- the subsidiary routines needed if these generics are used
|
|
|
536 -- are not loaded when they are not used.
|
|
|
537
|
|
|
538 ----------------
|
|
|
539 -- Exceptions --
|
|
|
540 ----------------
|
|
|
541
|
|
|
542 Status_Error : exception renames IO_Exceptions.Status_Error;
|
|
|
543 Mode_Error : exception renames IO_Exceptions.Mode_Error;
|
|
|
544 Name_Error : exception renames IO_Exceptions.Name_Error;
|
|
|
545 Use_Error : exception renames IO_Exceptions.Use_Error;
|
|
|
546 Device_Error : exception renames IO_Exceptions.Device_Error;
|
|
|
547 End_Error : exception renames IO_Exceptions.End_Error;
|
|
|
548 Data_Error : exception renames IO_Exceptions.Data_Error;
|
|
|
549 Layout_Error : exception renames IO_Exceptions.Layout_Error;
|
|
|
550
|
|
|
551 private
|
|
|
552
|
|
|
553 -- The following procedures have a File_Type formal of mode IN OUT because
|
|
|
554 -- they may close the original file. The Close operation may raise an
|
|
|
555 -- exception, but in that case we want any assignment to the formal to
|
|
|
556 -- be effective anyway, so it must be passed by reference (or the caller
|
|
|
557 -- will be left with a dangling pointer).
|
|
|
558
|
|
|
559 pragma Export_Procedure
|
|
|
560 (Internal => Close,
|
|
|
561 External => "",
|
|
|
562 Mechanism => Reference);
|
|
|
563 pragma Export_Procedure
|
|
|
564 (Internal => Delete,
|
|
|
565 External => "",
|
|
|
566 Mechanism => Reference);
|
|
|
567 pragma Export_Procedure
|
|
|
568 (Internal => Reset,
|
|
|
569 External => "",
|
|
|
570 Parameter_Types => (File_Type),
|
|
|
571 Mechanism => Reference);
|
|
|
572 pragma Export_Procedure
|
|
|
573 (Internal => Reset,
|
|
|
574 External => "",
|
|
|
575 Parameter_Types => (File_Type, File_Mode),
|
|
|
576 Mechanism => (File => Reference));
|
|
|
577
|
|
|
578 -----------------------------------
|
|
|
579 -- Handling of Format Characters --
|
|
|
580 -----------------------------------
|
|
|
581
|
|
|
582 -- Line marks are represented by the single character ASCII.LF (16#0A#).
|
|
|
583 -- In DOS and similar systems, underlying file translation takes care
|
|
|
584 -- of translating this to and from the standard CR/LF sequences used in
|
|
|
585 -- these operating systems to mark the end of a line. On output there is
|
|
|
586 -- always a line mark at the end of the last line, but on input, this
|
|
|
587 -- line mark can be omitted, and is implied by the end of file.
|
|
|
588
|
|
|
589 -- Page marks are represented by the single character ASCII.FF (16#0C#),
|
|
|
590 -- The page mark at the end of the file may be omitted, and is normally
|
|
|
591 -- omitted on output unless an explicit New_Page call is made before
|
|
|
592 -- closing the file. No page mark is added when a file is appended to,
|
|
|
593 -- so, in accordance with the permission in (RM A.10.2(4)), there may
|
|
|
594 -- or may not be a page mark separating preexisting text in the file
|
|
|
595 -- from the new text to be written.
|
|
|
596
|
|
|
597 -- A file mark is marked by the physical end of file. In DOS translation
|
|
|
598 -- mode on input, an EOF character (SUB = 16#1A#) gets translated to the
|
|
|
599 -- physical end of file, so in effect this character is recognized as
|
|
|
600 -- marking the end of file in DOS and similar systems.
|
|
|
601
|
|
|
602 LM : constant := Character'Pos (ASCII.LF);
|
|
|
603 -- Used as line mark
|
|
|
604
|
|
|
605 PM : constant := Character'Pos (ASCII.FF);
|
|
|
606 -- Used as page mark, except at end of file where it is implied
|
|
|
607
|
|
|
608 --------------------------------
|
|
|
609 -- Text_IO File Control Block --
|
|
|
610 --------------------------------
|
|
|
611
|
|
|
612 Default_WCEM : System.WCh_Con.WC_Encoding_Method :=
|
|
|
613 System.WCh_Con.WCEM_UTF8;
|
|
|
614 -- This gets modified during initialization (see body) using
|
|
|
615 -- the default value established in the call to Set_Globals.
|
|
|
616
|
|
|
617 package FCB renames System.File_Control_Block;
|
|
|
618
|
|
|
619 type Text_AFCB;
|
|
|
620 type File_Type is access all Text_AFCB;
|
|
|
621
|
|
|
622 type Text_AFCB is new FCB.AFCB with record
|
|
|
623 Page : Count := 1;
|
|
|
624 Line : Count := 1;
|
|
|
625 Col : Count := 1;
|
|
|
626 Line_Length : Count := 0;
|
|
|
627 Page_Length : Count := 0;
|
|
|
628
|
|
|
629 Self : aliased File_Type;
|
|
|
630 -- Set to point to the containing Text_AFCB block. This is used to
|
|
|
631 -- implement the Current_{Error,Input,Output} functions which return
|
|
|
632 -- a File_Access, the file access value returned is a pointer to
|
|
|
633 -- the Self field of the corresponding file.
|
|
|
634
|
|
|
635 Before_LM : Boolean := False;
|
|
|
636 -- This flag is used to deal with the anomalies introduced by the
|
|
|
637 -- peculiar definition of End_Of_File and End_Of_Page in Ada. These
|
|
|
638 -- functions require looking ahead more than one character. Since
|
|
|
639 -- there is no convenient way of backing up more than one character,
|
|
|
640 -- what we do is to leave ourselves positioned past the LM, but set
|
|
|
641 -- this flag, so that we know that from an Ada point of view we are
|
|
|
642 -- in front of the LM, not after it. A little odd, but it works.
|
|
|
643
|
|
|
644 Before_LM_PM : Boolean := False;
|
|
|
645 -- This flag similarly handles the case of being physically positioned
|
|
|
646 -- after a LM-PM sequence when logically we are before the LM-PM. This
|
|
|
647 -- flag can only be set if Before_LM is also set.
|
|
|
648
|
|
|
649 WC_Method : System.WCh_Con.WC_Encoding_Method := Default_WCEM;
|
|
|
650 -- Encoding method to be used for this file. Text_IO does not deal with
|
|
|
651 -- wide characters, but it does deal with upper half characters in the
|
|
|
652 -- range 16#80#-16#FF# which may need encoding, e.g. in UTF-8 mode.
|
|
|
653
|
|
|
654 Before_Upper_Half_Character : Boolean := False;
|
|
|
655 -- This flag is set to indicate that an encoded upper half character has
|
|
|
656 -- been read by Text_IO.Look_Ahead. If it is set to True, then it means
|
|
|
657 -- that the stream is logically positioned before the character but is
|
|
|
658 -- physically positioned after it. The character involved must be in
|
|
|
659 -- the range 16#80#-16#FF#, i.e. if the flag is set, then we know the
|
|
|
660 -- next character has a code greater than 16#7F#, and the value of this
|
|
|
661 -- character is saved in Saved_Upper_Half_Character.
|
|
|
662
|
|
|
663 Saved_Upper_Half_Character : Character;
|
|
|
664 -- This field is valid only if Before_Upper_Half_Character is set. It
|
|
|
665 -- contains an upper-half character read by Look_Ahead. If Look_Ahead
|
|
|
666 -- reads a character in the range 16#00# to 16#7F#, then it can use
|
|
|
667 -- ungetc to put it back, but ungetc cannot be called more than once,
|
|
|
668 -- so for characters above this range, we don't try to back up the
|
|
|
669 -- file. Instead we save the character in this field and set the flag
|
|
|
670 -- Before_Upper_Half_Character to True to indicate that we are logically
|
|
|
671 -- positioned before this character even though the stream is physically
|
|
|
672 -- positioned after it.
|
|
|
673
|
|
|
674 end record;
|
|
|
675
|
|
|
676 function AFCB_Allocate (Control_Block : Text_AFCB) return FCB.AFCB_Ptr;
|
|
|
677
|
|
|
678 procedure AFCB_Close (File : not null access Text_AFCB);
|
|
|
679 procedure AFCB_Free (File : not null access Text_AFCB);
|
|
|
680
|
|
|
681 procedure Read
|
|
|
682 (File : in out Text_AFCB;
|
|
|
683 Item : out Ada.Streams.Stream_Element_Array;
|
|
|
684 Last : out Ada.Streams.Stream_Element_Offset);
|
|
|
685 -- Read operation used when Text_IO file is treated directly as Stream
|
|
|
686
|
|
|
687 procedure Write
|
|
|
688 (File : in out Text_AFCB;
|
|
|
689 Item : Ada.Streams.Stream_Element_Array);
|
|
|
690 -- Write operation used when Text_IO file is treated directly as Stream
|
|
|
691
|
|
|
692 ------------------------
|
|
|
693 -- The Standard Files --
|
|
|
694 ------------------------
|
|
|
695
|
|
|
696 Standard_In_AFCB : aliased Text_AFCB;
|
|
|
697 Standard_Out_AFCB : aliased Text_AFCB;
|
|
|
698 Standard_Err_AFCB : aliased Text_AFCB;
|
|
|
699
|
|
145
|
700 Standard_In : aliased File_Type := Standard_In_AFCB'Access with
|
|
|
701 Part_Of => File_System;
|
|
|
702 Standard_Out : aliased File_Type := Standard_Out_AFCB'Access with
|
|
|
703 Part_Of => File_System;
|
|
|
704 Standard_Err : aliased File_Type := Standard_Err_AFCB'Access with
|
|
|
705 Part_Of => File_System;
|
|
111
|
706 -- Standard files
|
|
|
707
|
|
145
|
708 Current_In : aliased File_Type := Standard_In with
|
|
|
709 Part_Of => File_System;
|
|
|
710 Current_Out : aliased File_Type := Standard_Out with
|
|
|
711 Part_Of => File_System;
|
|
|
712 Current_Err : aliased File_Type := Standard_Err with
|
|
|
713 Part_Of => File_System;
|
|
111
|
714 -- Current files
|
|
|
715
|
|
|
716 function EOF_Char return Integer;
|
|
|
717 -- Returns the system-specific character indicating the end of a text file.
|
|
|
718 -- This is exported for use by child packages such as Enumeration_Aux to
|
|
|
719 -- eliminate their needing to depend directly on Interfaces.C_Streams,
|
|
|
720 -- which is not available in certain target environments (such as AAMP).
|
|
|
721
|
|
|
722 procedure Initialize_Standard_Files;
|
|
|
723 -- Initializes the file control blocks for the standard files. Called from
|
|
|
724 -- the elaboration routine for this package, and from Reset_Standard_Files
|
|
|
725 -- in package Ada.Text_IO.Reset_Standard_Files.
|
|
|
726
|
|
|
727 end Ada.Text_IO;
|
