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-2006, 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 2,  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.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT;  see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNAT was originally developed  by the GNAT team at  New York University. --
  30 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 package body Ada.Characters.Conversions is
  35
  36    ------------------
  37    -- Is_Character --
  38    ------------------
  39
  40    function Is_Character (Item : Wide_Character) return Boolean is
  41    begin
  42       return Wide_Character'Pos (Item) < 256;
  43    end Is_Character;
  44
  45    function Is_Character (Item : Wide_Wide_Character) return Boolean is
  46    begin
  47       return Wide_Wide_Character'Pos (Item) < 256;
  48    end Is_Character;
  49
  50    ---------------
  51    -- Is_String --
  52    ---------------
  53
  54    function Is_String (Item : Wide_String) return Boolean is
  55    begin
  56       for J in Item'Range loop
  57          if Wide_Character'Pos (Item (J)) >= 256 then
  58             return False;
  59          end if;
  60       end loop;
  61
  62       return True;
  63    end Is_String;
  64
  65    function Is_String (Item : Wide_Wide_String) return Boolean is
  66    begin
  67       for J in Item'Range loop
  68          if Wide_Wide_Character'Pos (Item (J)) >= 256 then
  69             return False;
  70          end if;
  71       end loop;
  72
  73       return True;
  74    end Is_String;
  75
  76    -----------------------
  77    -- Is_Wide_Character --
  78    -----------------------
  79
  80    function Is_Wide_Character (Item : Wide_Wide_Character) return Boolean is
  81    begin
  82       return Wide_Wide_Character'Pos (Item) < 2**16;
  83    end Is_Wide_Character;
  84
  85    --------------------
  86    -- Is_Wide_String --
  87    --------------------
  88
  89    function Is_Wide_String (Item : Wide_Wide_String) return Boolean is
  90    begin
  91       for J in Item'Range loop
  92          if Wide_Wide_Character'Pos (Item (J)) >= 2**16 then
  93             return False;
  94          end if;
  95       end loop;
  96
  97       return True;
  98    end Is_Wide_String;
  99
 100    ------------------
 101    -- To_Character --
 102    ------------------
 103
 104    function To_Character
 105      (Item       : Wide_Character;
 106       Substitute : Character := ' ') return Character
 107    is
 108    begin
 109       if Is_Character (Item) then
 110          return Character'Val (Wide_Character'Pos (Item));
 111       else
 112          return Substitute;
 113       end if;
 114    end To_Character;
 115
 116    function To_Character
 117      (Item       : Wide_Wide_Character;
 118       Substitute : Character := ' ') return Character
 119    is
 120    begin
 121       if Is_Character (Item) then
 122          return Character'Val (Wide_Wide_Character'Pos (Item));
 123       else
 124          return Substitute;
 125       end if;
 126    end To_Character;
 127
 128    ---------------
 129    -- To_String --
 130    ---------------
 131
 132    function To_String
 133      (Item       : Wide_String;
 134       Substitute : Character := ' ') return String
 135    is
 136       Result : String (1 .. Item'Length);
 137
 138    begin
 139       for J in Item'Range loop
 140          Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
 141       end loop;
 142
 143       return Result;
 144    end To_String;
 145
 146    function To_String
 147      (Item       : Wide_Wide_String;
 148       Substitute : Character := ' ') return String
 149    is
 150       Result : String (1 .. Item'Length);
 151
 152    begin
 153       for J in Item'Range loop
 154          Result (J - (Item'First - 1)) := To_Character (Item (J), Substitute);
 155       end loop;
 156
 157       return Result;
 158    end To_String;
 159
 160    -----------------------
 161    -- To_Wide_Character --
 162    -----------------------
 163
 164    function To_Wide_Character
 165      (Item : Character) return Wide_Character
 166    is
 167    begin
 168       return Wide_Character'Val (Character'Pos (Item));
 169    end To_Wide_Character;
 170
 171    function To_Wide_Character
 172      (Item       : Wide_Wide_Character;
 173       Substitute : Wide_Character := ' ') return Wide_Character
 174    is
 175    begin
 176       if Wide_Wide_Character'Pos (Item) < 2**16 then
 177          return Wide_Character'Val (Wide_Wide_Character'Pos (Item));
 178       else
 179          return Substitute;
 180       end if;
 181    end To_Wide_Character;
 182
 183    --------------------
 184    -- To_Wide_String --
 185    --------------------
 186
 187    function To_Wide_String
 188      (Item : String) return Wide_String
 189    is
 190       Result : Wide_String (1 .. Item'Length);
 191
 192    begin
 193       for J in Item'Range loop
 194          Result (J - (Item'First - 1)) := To_Wide_Character (Item (J));
 195       end loop;
 196
 197       return Result;
 198    end To_Wide_String;
 199
 200    function To_Wide_String
 201      (Item       : Wide_Wide_String;
 202       Substitute : Wide_Character := ' ') return Wide_String
 203    is
 204       Result : Wide_String (1 .. Item'Length);
 205
 206    begin
 207       for J in Item'Range loop
 208          Result (J - (Item'First - 1)) :=
 209            To_Wide_Character (Item (J), Substitute);
 210       end loop;
 211
 212       return Result;
 213    end To_Wide_String;
 214
 215    ----------------------------
 216    -- To_Wide_Wide_Character --
 217    ----------------------------
 218
 219    function To_Wide_Wide_Character
 220      (Item : Character) return Wide_Wide_Character
 221    is
 222    begin
 223       return Wide_Wide_Character'Val (Character'Pos (Item));
 224    end To_Wide_Wide_Character;
 225
 226    function To_Wide_Wide_Character
 227      (Item : Wide_Character) return Wide_Wide_Character
 228    is
 229    begin
 230       return Wide_Wide_Character'Val (Wide_Character'Pos (Item));
 231    end To_Wide_Wide_Character;
 232
 233    -------------------------
 234    -- To_Wide_Wide_String --
 235    -------------------------
 236
 237    function To_Wide_Wide_String
 238      (Item : String) return Wide_Wide_String
 239    is
 240       Result : Wide_Wide_String (1 .. Item'Length);
 241
 242    begin
 243       for J in Item'Range loop
 244          Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
 245       end loop;
 246
 247       return Result;
 248    end To_Wide_Wide_String;
 249
 250    function To_Wide_Wide_String
 251      (Item : Wide_String) return Wide_Wide_String
 252    is
 253       Result : Wide_Wide_String (1 .. Item'Length);
 254
 255    begin
 256       for J in Item'Range loop
 257          Result (J - (Item'First - 1)) := To_Wide_Wide_Character (Item (J));
 258       end loop;
 259
 260       return Result;
 261    end To_Wide_Wide_String;
 262
 263 end Ada.Characters.Conversions;