File : a-suteio.adb
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT RUN-TIME COMPONENTS --
4 -- --
5 -- A D A . S T R I N G S . U N B O U N D E D . T E X T _ I O --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1997-2009, Free Software Foundation, Inc. --
10 -- --
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. --
17 -- --
18 -- --
19 -- --
20 -- --
21 -- --
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/>. --
26 -- --
27 -- GNAT was originally developed by the GNAT team at New York University. --
28 -- Extensive contributions were provided by Ada Core Technologies Inc. --
29 -- --
30 ------------------------------------------------------------------------------
31
32 with Ada.Text_IO; use Ada.Text_IO;
33
34 package body Ada.Strings.Unbounded.Text_IO is
35
36 --------------
37 -- Get_Line --
38 --------------
39
40 function Get_Line return Unbounded_String is
41 Buffer : String (1 .. 1000);
42 Last : Natural;
43 Str1 : String_Access;
44 Str2 : String_Access;
45 Result : Unbounded_String;
46
47 begin
48 Get_Line (Buffer, Last);
49 Str1 := new String'(Buffer (1 .. Last));
50 while Last = Buffer'Last loop
51 Get_Line (Buffer, Last);
52 Str2 := new String (1 .. Str1'Last + Last);
53 Str2 (Str1'Range) := Str1.all;
54 Str2 (Str1'Last + 1 .. Str2'Last) := Buffer (1 .. Last);
55 Free (Str1);
56 Str1 := Str2;
57 end loop;
58
59 Result.Reference := Str1;
60 Result.Last := Str1'Length;
61 return Result;
62 end Get_Line;
63
64 function Get_Line (File : Ada.Text_IO.File_Type) return Unbounded_String is
65 Buffer : String (1 .. 1000);
66 Last : Natural;
67 Str1 : String_Access;
68 Str2 : String_Access;
69 Result : Unbounded_String;
70
71 begin
72 Get_Line (File, Buffer, Last);
73 Str1 := new String'(Buffer (1 .. Last));
74 while Last = Buffer'Last loop
75 Get_Line (File, Buffer, Last);
76 Str2 := new String (1 .. Str1'Last + Last);
77 Str2 (Str1'Range) := Str1.all;
78 Str2 (Str1'Last + 1 .. Str2'Last) := Buffer (1 .. Last);
79 Free (Str1);
80 Str1 := Str2;
81 end loop;
82
83 Result.Reference := Str1;
84 Result.Last := Str1'Length;
85 return Result;
86 end Get_Line;
87
88 procedure Get_Line (Item : out Unbounded_String) is
89 begin
90 Get_Line (Current_Input, Item);
91 end Get_Line;
92
93 procedure Get_Line
94 (File : Ada.Text_IO.File_Type;
95 Item : out Unbounded_String)
96 is
97 begin
98 -- We are going to read into the string that is already there and
99 -- allocated. Hopefully it is big enough now, if not, we will extend
100 -- it in the usual manner using Realloc_For_Chunk.
101
102 -- Make sure we start with at least 80 characters
103
104 if Item.Reference'Last < 80 then
105 Realloc_For_Chunk (Item, 80);
106 end if;
107
108 -- Loop to read data, filling current string as far as possible.
109 -- Item.Last holds the number of characters read so far.
110
111 Item.Last := 0;
112 loop
113 Get_Line
114 (File,
115 Item.Reference (Item.Last + 1 .. Item.Reference'Last),
116 Item.Last);
117
118 -- If we hit the end of the line before the end of the buffer, then
119 -- we are all done, and the result length is properly set.
120
121 if Item.Last < Item.Reference'Last then
122 return;
123 end if;
124
125 -- If not enough room, double it and keep reading
126
127 Realloc_For_Chunk (Item, Item.Last);
128 end loop;
129 end Get_Line;
130
131 ---------
132 -- Put --
133 ---------
134
135 procedure Put (U : Unbounded_String) is
136 begin
137 Put (U.Reference (1 .. U.Last));
138 end Put;
139
140 procedure Put (File : File_Type; U : Unbounded_String) is
141 begin
142 Put (File, U.Reference (1 .. U.Last));
143 end Put;
144
145 --------------
146 -- Put_Line --
147 --------------
148
149 procedure Put_Line (U : Unbounded_String) is
150 begin
151 Put_Line (U.Reference (1 .. U.Last));
152 end Put_Line;
153
154 procedure Put_Line (File : File_Type; U : Unbounded_String) is
155 begin
156 Put_Line (File, U.Reference (1 .. U.Last));
157 end Put_Line;
158
159 end Ada.Strings.Unbounded.Text_IO;