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-2012, 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
32package 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
261end Ada.Characters.Conversions;
262