OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [ada/] [a-zzboio.adb] - Blame information for rev 307

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 281 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--                 ADA.WIDE_WIDE_TEXT_IO.WIDE_WIDE_BOUNDED_IO               --
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
-- 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.               --
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.Wide_Wide_Text_IO; use Ada.Wide_Wide_Text_IO;
33
with Ada.Unchecked_Deallocation;
34
 
35
package body Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO is
36
 
37
   type Wide_Wide_String_Access is access all Wide_Wide_String;
38
 
39
   procedure Free (WWSA : in out Wide_Wide_String_Access);
40
   --  Perform an unchecked deallocation of a non-null string
41
 
42
   ----------
43
   -- Free --
44
   ----------
45
 
46
   procedure Free (WWSA : in out Wide_Wide_String_Access) is
47
      Null_Wide_Wide_String : constant Wide_Wide_String := "";
48
 
49
      procedure Deallocate is
50
        new Ada.Unchecked_Deallocation (
51
          Wide_Wide_String, Wide_Wide_String_Access);
52
 
53
   begin
54
      --  Do not try to free statically allocated null string
55
 
56
      if WWSA.all /= Null_Wide_Wide_String then
57
         Deallocate (WWSA);
58
      end if;
59
   end Free;
60
 
61
   --------------
62
   -- Get_Line --
63
   --------------
64
 
65
   function Get_Line return Wide_Wide_Bounded.Bounded_Wide_Wide_String is
66
   begin
67
      return Wide_Wide_Bounded.To_Bounded_Wide_Wide_String (Get_Line);
68
   end Get_Line;
69
 
70
   --------------
71
   -- Get_Line --
72
   --------------
73
 
74
   function Get_Line
75
     (File : File_Type) return Wide_Wide_Bounded.Bounded_Wide_Wide_String
76
   is
77
   begin
78
      return Wide_Wide_Bounded.To_Bounded_Wide_Wide_String (Get_Line (File));
79
   end Get_Line;
80
 
81
   --------------
82
   -- Get_Line --
83
   --------------
84
 
85
   procedure Get_Line
86
     (Item : out Wide_Wide_Bounded.Bounded_Wide_Wide_String)
87
   is
88
      Buffer : Wide_Wide_String (1 .. 1000);
89
      Last   : Natural;
90
      Str1   : Wide_Wide_String_Access;
91
      Str2   : Wide_Wide_String_Access;
92
 
93
   begin
94
      Get_Line (Buffer, Last);
95
      Str1 := new Wide_Wide_String'(Buffer (1 .. Last));
96
 
97
      while Last = Buffer'Last loop
98
         Get_Line (Buffer, Last);
99
         Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last));
100
         Free (Str1);
101
         Str1 := Str2;
102
      end loop;
103
 
104
      Item := Wide_Wide_Bounded.To_Bounded_Wide_Wide_String (Str1.all);
105
   end Get_Line;
106
 
107
   --------------
108
   -- Get_Line --
109
   --------------
110
 
111
   procedure Get_Line
112
     (File : File_Type;
113
      Item : out Wide_Wide_Bounded.Bounded_Wide_Wide_String)
114
   is
115
      Buffer : Wide_Wide_String (1 .. 1000);
116
      Last   : Natural;
117
      Str1   : Wide_Wide_String_Access;
118
      Str2   : Wide_Wide_String_Access;
119
 
120
   begin
121
      Get_Line (File, Buffer, Last);
122
      Str1 := new Wide_Wide_String'(Buffer (1 .. Last));
123
 
124
      while Last = Buffer'Last loop
125
         Get_Line (File, Buffer, Last);
126
         Str2 := new Wide_Wide_String'(Str1.all & Buffer (1 .. Last));
127
         Free (Str1);
128
         Str1 := Str2;
129
      end loop;
130
 
131
      Item := Wide_Wide_Bounded.To_Bounded_Wide_Wide_String (Str1.all);
132
   end Get_Line;
133
 
134
   ---------
135
   -- Put --
136
   ---------
137
 
138
   procedure Put
139
     (Item : Wide_Wide_Bounded.Bounded_Wide_Wide_String)
140
   is
141
   begin
142
      Put (Wide_Wide_Bounded.To_Wide_Wide_String (Item));
143
   end Put;
144
 
145
   ---------
146
   -- Put --
147
   ---------
148
 
149
   procedure Put
150
     (File : File_Type;
151
      Item : Wide_Wide_Bounded.Bounded_Wide_Wide_String)
152
   is
153
   begin
154
      Put (File, Wide_Wide_Bounded.To_Wide_Wide_String (Item));
155
   end Put;
156
 
157
   --------------
158
   -- Put_Line --
159
   --------------
160
 
161
   procedure Put_Line
162
     (Item : Wide_Wide_Bounded.Bounded_Wide_Wide_String)
163
   is
164
   begin
165
      Put_Line (Wide_Wide_Bounded.To_Wide_Wide_String (Item));
166
   end Put_Line;
167
 
168
   --------------
169
   -- Put_Line --
170
   --------------
171
 
172
   procedure Put_Line
173
     (File : File_Type;
174
      Item : Wide_Wide_Bounded.Bounded_Wide_Wide_String)
175
   is
176
   begin
177
      Put_Line (File, Wide_Wide_Bounded.To_Wide_Wide_String (Item));
178
   end Put_Line;
179
 
180
end Ada.Wide_Wide_Text_IO.Wide_Wide_Bounded_IO;

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.