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