gcc/ada/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 -- 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;