1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ T E X T _ I O . G E N E R I C _ A U X --
9 -- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
30 ------------------------------------------------------------------------------
32 with Interfaces.C_Streams; use Interfaces.C_Streams;
34 with System.File_Control_Block;
36 package body Ada.Wide_Text_IO.Generic_Aux is
38 package FIO renames System.File_IO;
39 package FCB renames System.File_Control_Block;
40 subtype AP is FCB.AFCB_Ptr;
42 ------------------------
43 -- Check_End_Of_Field --
44 ------------------------
46 procedure Check_End_Of_Field
60 for J in Ptr .. Stop loop
61 if not Is_Blank (Buf (J)) then
66 end Check_End_Of_Field;
68 -----------------------
69 -- Check_On_One_Line --
70 -----------------------
72 procedure Check_On_One_Line
77 FIO.Check_Write_Status (AP (File));
79 if File.Line_Length /= 0 then
80 if Count (Length) > File.Line_Length then
82 elsif File.Col + Count (Length) > File.Line_Length + 1 then
86 end Check_On_One_Line;
92 function Is_Blank (C : Character) return Boolean is
94 return C = ' ' or else C = ASCII.HT;
104 Ptr : in out Integer;
106 Loaded : out Boolean)
111 if File.Before_Wide_Character then
118 if ch = Character'Pos (Char) then
119 Store_Char (File, ch, Buf, Ptr);
131 Ptr : in out Integer;
137 if File.Before_Wide_Character then
143 if ch = Character'Pos (Char) then
144 Store_Char (File, ch, Buf, Ptr);
154 Ptr : in out Integer;
157 Loaded : out Boolean)
162 if File.Before_Wide_Character then
169 if ch = Character'Pos (Char1)
170 or else ch = Character'Pos (Char2)
172 Store_Char (File, ch, Buf, Ptr);
184 Ptr : in out Integer;
191 if File.Before_Wide_Character then
197 if ch = Character'Pos (Char1)
198 or else ch = Character'Pos (Char2)
200 Store_Char (File, ch, Buf, Ptr);
211 procedure Load_Digits
214 Ptr : in out Integer;
215 Loaded : out Boolean)
218 After_Digit : Boolean;
221 if File.Before_Wide_Character then
228 if ch not in Character'Pos ('0') .. Character'Pos ('9') then
236 Store_Char (File, ch, Buf, Ptr);
239 if ch in Character'Pos ('0') .. Character'Pos ('9') then
242 elsif ch = Character'Pos ('_') and then After_Digit then
243 After_Digit := False;
255 procedure Load_Digits
258 Ptr : in out Integer)
261 After_Digit : Boolean;
264 if File.Before_Wide_Character then
270 if ch in Character'Pos ('0') .. Character'Pos ('9') then
274 Store_Char (File, ch, Buf, Ptr);
277 if ch in Character'Pos ('0') .. Character'Pos ('9') then
280 elsif ch = Character'Pos ('_') and then After_Digit then
281 After_Digit := False;
293 --------------------------
294 -- Load_Extended_Digits --
295 --------------------------
297 procedure Load_Extended_Digits
300 Ptr : in out Integer;
301 Loaded : out Boolean)
304 After_Digit : Boolean := False;
307 if File.Before_Wide_Character then
317 if ch in Character'Pos ('0') .. Character'Pos ('9')
319 ch in Character'Pos ('a') .. Character'Pos ('f')
321 ch in Character'Pos ('A') .. Character'Pos ('F')
325 elsif ch = Character'Pos ('_') and then After_Digit then
326 After_Digit := False;
332 Store_Char (File, ch, Buf, Ptr);
338 end Load_Extended_Digits;
340 procedure Load_Extended_Digits
343 Ptr : in out Integer)
346 pragma Unreferenced (Junk);
348 Load_Extended_Digits (File, Buf, Ptr, Junk);
349 end Load_Extended_Digits;
355 procedure Load_Skip (File : File_Type) is
359 FIO.Check_Read_Status (AP (File));
361 -- We need to explicitly test for the case of being before a wide
362 -- character (greater than 16#7F#). Since no such character can
363 -- ever legitimately be a valid numeric character, we can
364 -- immediately signal Data_Error.
366 if File.Before_Wide_Character then
370 -- Otherwise loop till we find a non-blank character (note that as
371 -- usual in Wide_Text_IO, blank includes horizontal tab). Note that
372 -- Get_Character deals with Before_LM/Before_LM_PM flags appropriately.
375 Get_Character (File, C);
376 exit when not Is_Blank (C);
379 Ungetc (Character'Pos (C), File);
380 File.Col := File.Col - 1;
391 Ptr : in out Integer)
396 Bad_Wide_C : Boolean := False;
397 -- Set True if one of the characters read is not in range of type
398 -- Character. This is always a Data_Error, but we do not signal it
399 -- right away, since we have to read the full number of characters.
402 FIO.Check_Read_Status (AP (File));
404 -- If we are immediately before a line mark, then we have no characters.
405 -- This is always a data error, so we may as well raise it right away.
407 if File.Before_LM then
411 for J in 1 .. Width loop
412 if File.Before_Wide_Character then
414 Store_Char (File, 0, Buf, Ptr);
415 File.Before_Wide_Character := False;
428 WC := Get_Wide_Char (Character'Val (ch), File);
429 ch := Wide_Character'Pos (WC);
436 Store_Char (File, ch, Buf, Ptr);
451 procedure Put_Item (File : File_Type; Str : String) is
453 Check_On_One_Line (File, Str'Length);
455 for J in Str'Range loop
456 Put (File, Wide_Character'Val (Character'Pos (Str (J))));
468 Ptr : in out Integer)
471 File.Col := File.Col + 1;
473 if Ptr = Buf'Last then
477 Buf (Ptr) := Character'Val (ch);
485 procedure String_Skip (Str : String; Ptr : out Integer) is
490 if Ptr > Str'Last then
493 elsif not Is_Blank (Str (Ptr)) then
506 procedure Ungetc (ch : int; File : File_Type) is
509 if ungetc (ch, File.Stream) = EOF then
515 end Ada.Wide_Text_IO.Generic_Aux;