]>
Commit | Line | Data |
---|---|---|
d23b8f57 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT RUNTIME 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 | -- -- | |
82c80734 | 9 | -- Copyright (C) 1997-2005 Free Software Foundation, Inc. -- |
d23b8f57 RK |
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 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, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
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. -- | |
28 | -- -- | |
29 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 30 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
d23b8f57 RK |
31 | -- -- |
32 | ------------------------------------------------------------------------------ | |
33 | ||
798a9055 | 34 | with Ada.Text_IO; use Ada.Text_IO; |
d23b8f57 RK |
35 | |
36 | package body Ada.Strings.Unbounded.Text_IO is | |
37 | ||
38 | -------------- | |
39 | -- Get_Line -- | |
40 | -------------- | |
41 | ||
42 | function Get_Line return Unbounded_String is | |
43 | Buffer : String (1 .. 1000); | |
44 | Last : Natural; | |
45 | Str1 : String_Access; | |
46 | Str2 : String_Access; | |
47 | Result : Unbounded_String; | |
48 | ||
49 | begin | |
50 | Get_Line (Buffer, Last); | |
51 | Str1 := new String'(Buffer (1 .. Last)); | |
d23b8f57 RK |
52 | while Last = Buffer'Last loop |
53 | Get_Line (Buffer, Last); | |
54 | Str2 := new String'(Str1.all & Buffer (1 .. Last)); | |
55 | Free (Str1); | |
56 | Str1 := Str2; | |
57 | end loop; | |
58 | ||
798a9055 RD |
59 | Result.Reference := Str1; |
60 | Result.Last := Str1'Length; | |
d23b8f57 RK |
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)); | |
d23b8f57 RK |
74 | while Last = Buffer'Last loop |
75 | Get_Line (File, Buffer, Last); | |
76 | Str2 := new String'(Str1.all & Buffer (1 .. Last)); | |
77 | Free (Str1); | |
78 | Str1 := Str2; | |
79 | end loop; | |
80 | ||
798a9055 RD |
81 | Result.Reference := Str1; |
82 | Result.Last := Str1'Length; | |
d23b8f57 RK |
83 | return Result; |
84 | end Get_Line; | |
85 | ||
82c80734 | 86 | procedure Get_Line (Item : out Unbounded_String) is |
82c80734 | 87 | begin |
798a9055 | 88 | Get_Line (Current_Input, Item); |
82c80734 RD |
89 | end Get_Line; |
90 | ||
91 | procedure Get_Line | |
92 | (File : Ada.Text_IO.File_Type; | |
93 | Item : out Unbounded_String) | |
94 | is | |
82c80734 | 95 | begin |
798a9055 RD |
96 | -- We are going to read into the string that is already there and |
97 | -- allocated. Hopefully it is big enough now, if not, we will extend | |
98 | -- it in the usual manner using Realloc_For_Chunk. | |
82c80734 | 99 | |
798a9055 RD |
100 | -- Make sure we start with at least 80 characters |
101 | ||
102 | if Item.Reference'Last < 80 then | |
103 | Realloc_For_Chunk (Item, 80); | |
104 | end if; | |
105 | ||
106 | -- Loop to read data, filling current string as far as possible. | |
107 | -- Item.Last holds the number of characters read so far. | |
108 | ||
109 | Item.Last := 0; | |
110 | loop | |
111 | Get_Line | |
112 | (File, | |
113 | Item.Reference (Item.Last + 1 .. Item.Reference'Last), | |
114 | Item.Last); | |
115 | ||
116 | -- If we hit the end of the line before the end of the buffer, then | |
117 | -- we are all done, and the result length is properly set. | |
118 | ||
119 | if Item.Last < Item.Reference'Last then | |
120 | return; | |
121 | end if; | |
122 | ||
123 | -- If not enough room, double it and keep reading | |
124 | ||
125 | Realloc_For_Chunk (Item, Item.Last); | |
126 | end loop; | |
82c80734 RD |
127 | end Get_Line; |
128 | ||
d23b8f57 RK |
129 | --------- |
130 | -- Put -- | |
131 | --------- | |
132 | ||
133 | procedure Put (U : Unbounded_String) is | |
134 | begin | |
798a9055 | 135 | Put (U.Reference (1 .. U.Last)); |
d23b8f57 RK |
136 | end Put; |
137 | ||
138 | procedure Put (File : File_Type; U : Unbounded_String) is | |
139 | begin | |
798a9055 | 140 | Put (File, U.Reference (1 .. U.Last)); |
d23b8f57 RK |
141 | end Put; |
142 | ||
143 | -------------- | |
144 | -- Put_Line -- | |
145 | -------------- | |
146 | ||
147 | procedure Put_Line (U : Unbounded_String) is | |
148 | begin | |
798a9055 | 149 | Put_Line (U.Reference (1 .. U.Last)); |
d23b8f57 RK |
150 | end Put_Line; |
151 | ||
152 | procedure Put_Line (File : File_Type; U : Unbounded_String) is | |
153 | begin | |
798a9055 | 154 | Put_Line (File, U.Reference (1 .. U.Last)); |
d23b8f57 RK |
155 | end Put_Line; |
156 | ||
157 | end Ada.Strings.Unbounded.Text_IO; |