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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [a-chacon.adb] - Blame information for rev 706

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 706 jeremybenn
------------------------------------------------------------------------------
2
--                                                                          --
3
--                         GNAT RUN-TIME COMPONENTS                         --
4
--                                                                          --
5
--           A D A . C H A R A C T E R S . C O N V E R S I O N S            --
6
--                                                                          --
7
--                                 B o d y                                  --
8
--                                                                          --
9
--          Copyright (C) 2005-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
package body Ada.Characters.Conversions is
33
 
34
   ------------------
35
   -- Is_Character --
36
   ------------------
37
 
38
   function Is_Character (Item : Wide_Character) return Boolean is
39
   begin
40
      return Wide_Character'Pos (Item) < 256;
41
   end Is_Character;
42
 
43
   function Is_Character (Item : Wide_Wide_Character) return Boolean is
44
   begin
45
      return Wide_Wide_Character'Pos (Item) < 256;
46
   end Is_Character;
47
 
48
   ---------------
49
   -- Is_String --
50
   ---------------
51
 
52
   function Is_String (Item : Wide_String) return Boolean is
53
   begin
54
      for J in Item'Range loop
55
         if Wide_Character'Pos (Item (J)) >= 256 then
56
            return False;
57
         end if;
58
      end loop;
59
 
60
      return True;
61
   end Is_String;
62
 
63
   function Is_String (Item : Wide_Wide_String) return Boolean is
64
   begin
65
      for J in Item'Range loop
66
         if Wide_Wide_Character'Pos (Item (J)) >= 256 then
67
            return False;
68
         end if;
69
      end loop;
70
 
71
      return True;
72
   end Is_String;
73
 
74
   -----------------------
75
   -- Is_Wide_Character --
76
   -----------------------
77
 
78
   function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
79
   begin
80
      return Wide_Wide_Character'Pos (Item) < 2**16;
81
   end Is_Wide_Character;
82
 
83
   --------------------
84
   -- Is_Wide_String --
85
   --------------------
86
 
87
   function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
88
   begin
89
      for J in Item'Range loop
90
         if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
91
            return False;
92
         end if;
93
      end loop;
94
 
95
      return True;
96
   end Is_Wide_String;
97
 
98
   ------------------
99
   -- To_Character --
100
   ------------------
101
 
102
   function To_Character
103
     (Item       : Wide_Character;
104
      Substitute : Character := ' ') return Character
105
   is
106
   begin
107
      if Is_Character (Item) then
108
         return Character'Val (Wide_Character'Pos (Item));
109
      else
110
         return Substitute;
111
      end if;
112
   end To_Character;
113
 
114
   function To_Character
115
     (Item       : Wide_Wide_Character;
116
      Substitute : Character := ' ') return Character
117
   is
118
   begin
119
      if Is_Character (Item) then
120
         return Character'Val (Wide_Wide_Character'Pos (Item));
121
      else
122
         return Substitute;
123
      end if;
124
   end To_Character;
125
 
126
   ---------------
127
   -- To_String --
128
   ---------------
129
 
130
   function To_String
131
     (Item       : Wide_String;
132
      Substitute : Character := ' ') return String
133
   is
134
      Result : String (1 .. Item'Length);
135
 
136
   begin
137
      for J in Item'Range loop
138
         Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
139
      end loop;
140
 
141
      return Result;
142
   end To_String;
143
 
144
   function To_String
145
     (Item       : Wide_Wide_String;
146
      Substitute : Character := ' ') return String
147
   is
148
      Result : String (1 .. Item'Length);
149
 
150
   begin
151
      for J in Item'Range loop
152
         Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
153
      end loop;
154
 
155
      return Result;
156
   end To_String;
157
 
158
   -----------------------
159
   -- To_Wide_Character --
160
   -----------------------
161
 
162
   function To_Wide_Character
163
     (Item : Character) return Wide_Character
164
   is
165
   begin
166
      return Wide_Character'Val (Character'Pos (Item));
167
   end To_Wide_Character;
168
 
169
   function To_Wide_Character
170
     (Item       : Wide_Wide_Character;
171
      Substitute : Wide_Character := ' ') return Wide_Character
172
   is
173
   begin
174
      if Wide_Wide_Character'Pos (Item) < 2**16 then
175
         return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
176
      else
177
         return Substitute;
178
      end if;
179
   end To_Wide_Character;
180
 
181
   --------------------
182
   -- To_Wide_String --
183
   --------------------
184
 
185
   function To_Wide_String
186
     (Item : String) return Wide_String
187
   is
188
      Result : Wide_String (1 .. Item'Length);
189
 
190
   begin
191
      for J in Item'Range loop
192
         Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
193
      end loop;
194
 
195
      return Result;
196
   end To_Wide_String;
197
 
198
   function To_Wide_String
199
     (Item       : Wide_Wide_String;
200
      Substitute : Wide_Character := ' ') return Wide_String
201
   is
202
      Result : Wide_String (1 .. Item'Length);
203
 
204
   begin
205
      for J in Item'Range loop
206
         Result (J - (Item'First - 1)) :=
207
           To_Wide_Character (Item (J), Substitute);
208
      end loop;
209
 
210
      return Result;
211
   end To_Wide_String;
212
 
213
   ----------------------------
214
   -- To_Wide_Wide_Character --
215
   ----------------------------
216
 
217
   function To_Wide_Wide_Character
218
     (Item : Character) return Wide_Wide_Character
219
   is
220
   begin
221
      return Wide_Wide_Character'Val (Character'Pos (Item));
222
   end To_Wide_Wide_Character;
223
 
224
   function To_Wide_Wide_Character
225
     (Item : Wide_Character) return Wide_Wide_Character
226
   is
227
   begin
228
      return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
229
   end To_Wide_Wide_Character;
230
 
231
   -------------------------
232
   -- To_Wide_Wide_String --
233
   -------------------------
234
 
235
   function To_Wide_Wide_String
236
     (Item : String) return Wide_Wide_String
237
   is
238
      Result : Wide_Wide_String (1 .. Item'Length);
239
 
240
   begin
241
      for J in Item'Range loop
242
         Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
243
      end loop;
244
 
245
      return Result;
246
   end To_Wide_Wide_String;
247
 
248
   function To_Wide_Wide_String
249
     (Item : Wide_String) return Wide_Wide_String
250
   is
251
      Result : Wide_Wide_String (1 .. Item'Length);
252
 
253
   begin
254
      for J in Item'Range loop
255
         Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
256
      end loop;
257
 
258
      return Result;
259
   end To_Wide_Wide_String;
260
 
261
end Ada.Characters.Conversions;

powered by: WebSVN 2.1.0

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