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