1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME COMPONENTS --
5 -- A D A . W I D E _ W I D E _ T E X T _ I O . G E N E R I C _ A U X --
9 -- Copyright (C) 1992-2005, 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 2, 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Interfaces.C_Streams; use Interfaces.C_Streams;
36 with System.File_Control_Block;
38 package body Ada.Wide_Wide_Text_IO.Generic_Aux is
40 package FIO renames System.File_IO;
41 package FCB renames System.File_Control_Block;
42 subtype AP is FCB.AFCB_Ptr;
44 ------------------------
45 -- Check_End_Of_Field --
46 ------------------------
48 procedure Check_End_Of_Field
62 for J in Ptr .. Stop loop
63 if not Is_Blank (Buf (J)) then
68 end Check_End_Of_Field;
70 -----------------------
71 -- Check_On_One_Line --
72 -----------------------
74 procedure Check_On_One_Line
79 FIO.Check_Write_Status (AP (File));
81 if File.Line_Length /= 0 then
82 if Count (Length) > File.Line_Length then
84 elsif File.Col + Count (Length) > File.Line_Length + 1 then
88 end Check_On_One_Line;
94 function Is_Blank (C : Character) return Boolean is
96 return C = ' ' or else C = ASCII.HT;
106 Ptr : in out Integer;
108 Loaded : out Boolean)
113 if File.Before_Wide_Wide_Character then
120 if ch = Character'Pos (Char) then
121 Store_Char (File, ch, Buf, Ptr);
133 Ptr : in out Integer;
139 if File.Before_Wide_Wide_Character then
145 if ch = Character'Pos (Char) then
146 Store_Char (File, ch, Buf, Ptr);
156 Ptr : in out Integer;
159 Loaded : out Boolean)
164 if File.Before_Wide_Wide_Character then
171 if ch = Character'Pos (Char1)
172 or else ch = Character'Pos (Char2)
174 Store_Char (File, ch, Buf, Ptr);
186 Ptr : in out Integer;
193 if File.Before_Wide_Wide_Character then
199 if ch = Character'Pos (Char1)
200 or else ch = Character'Pos (Char2)
202 Store_Char (File, ch, Buf, Ptr);
213 procedure Load_Digits
216 Ptr : in out Integer;
217 Loaded : out Boolean)
220 After_Digit : Boolean;
223 if File.Before_Wide_Wide_Character then
230 if ch not in Character'Pos ('0') .. Character'Pos ('9') then
238 Store_Char (File, ch, Buf, Ptr);
241 if ch in Character'Pos ('0') .. Character'Pos ('9') then
244 elsif ch = Character'Pos ('_') and then After_Digit then
245 After_Digit := False;
257 procedure Load_Digits
260 Ptr : in out Integer)
263 After_Digit : Boolean;
266 if File.Before_Wide_Wide_Character then
272 if ch in Character'Pos ('0') .. Character'Pos ('9') then
276 Store_Char (File, ch, Buf, Ptr);
279 if ch in Character'Pos ('0') .. Character'Pos ('9') then
282 elsif ch = Character'Pos ('_') and then After_Digit then
283 After_Digit := False;
295 --------------------------
296 -- Load_Extended_Digits --
297 --------------------------
299 procedure Load_Extended_Digits
302 Ptr : in out Integer;
303 Loaded : out Boolean)
306 After_Digit : Boolean := False;
309 if File.Before_Wide_Wide_Character then
319 if ch in Character'Pos ('0') .. Character'Pos ('9')
321 ch in Character'Pos ('a') .. Character'Pos ('f')
323 ch in Character'Pos ('A') .. Character'Pos ('F')
327 elsif ch = Character'Pos ('_') and then After_Digit then
328 After_Digit := False;
334 Store_Char (File, ch, Buf, Ptr);
340 end Load_Extended_Digits;
342 procedure Load_Extended_Digits
345 Ptr : in out Integer)
350 Load_Extended_Digits (File, Buf, Ptr, Junk);
351 end Load_Extended_Digits;
357 procedure Load_Skip (File : File_Type) is
361 FIO.Check_Read_Status (AP (File));
363 -- We need to explicitly test for the case of being before a wide
364 -- character (greater than 16#7F#). Since no such character can
365 -- ever legitimately be a valid numeric character, we can
366 -- immediately signal Data_Error.
368 if File.Before_Wide_Wide_Character then
372 -- Otherwise loop till we find a non-blank character (note that as
373 -- usual in Wide_Wide_Text_IO, blank includes horizontal tab). Note that
374 -- Get_Character deals with Before_LM/Before_LM_PM flags appropriately.
377 Get_Character (File, C);
378 exit when not Is_Blank (C);
381 Ungetc (Character'Pos (C), File);
382 File.Col := File.Col - 1;
393 Ptr : in out Integer)
396 WC : Wide_Wide_Character;
398 Bad_Wide_Wide_C : Boolean := False;
399 -- Set True if one of the characters read is not in range of type
400 -- Character. This is always a Data_Error, but we do not signal it
401 -- right away, since we have to read the full number of characters.
404 FIO.Check_Read_Status (AP (File));
406 -- If we are immediately before a line mark, then we have no characters.
407 -- This is always a data error, so we may as well raise it right away.
409 if File.Before_LM then
413 for J in 1 .. Width loop
414 if File.Before_Wide_Wide_Character then
415 Bad_Wide_Wide_C := True;
416 Store_Char (File, 0, Buf, Ptr);
417 File.Before_Wide_Wide_Character := False;
430 WC := Get_Wide_Wide_Char (Character'Val (ch), File);
431 ch := Wide_Wide_Character'Pos (WC);
434 Bad_Wide_Wide_C := True;
438 Store_Char (File, ch, Buf, Ptr);
443 if Bad_Wide_Wide_C then
453 procedure Put_Item (File : File_Type; Str : String) is
455 Check_On_One_Line (File, Str'Length);
457 for J in Str'Range loop
458 Put (File, Wide_Wide_Character'Val (Character'Pos (Str (J))));
470 Ptr : in out Integer)
473 File.Col := File.Col + 1;
475 if Ptr = Buf'Last then
479 Buf (Ptr) := Character'Val (ch);
487 procedure String_Skip (Str : String; Ptr : out Integer) is
492 if Ptr > Str'Last then
495 elsif not Is_Blank (Str (Ptr)) then
508 procedure Ungetc (ch : int; File : File_Type) is
511 if ungetc (ch, File.Stream) = EOF then
517 end Ada.Wide_Wide_Text_IO.Generic_Aux;