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 729

Go to most recent revision | 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.