File : a-chacon.adb
1 ------------------------------------------------------------------------------
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 -- --
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 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;