gcc/ada/libgnat/a-zchuni.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT RUN-TIME COMPONENTS                         --
   4 --                                                                          --
   5 --    A D A . W I D E _ W I D E _ C H A R A C T E R T S . U N I C O D E     --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 2005-2018, 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.Wide_Wide_Characters.Unicode is
  33
  34    package G renames System.UTF_32;
  35
  36    ------------------
  37    -- Get_Category --
  38    ------------------
  39
  40    function Get_Category (U : Wide_Wide_Character) return Category is
  41    begin
  42       return Category (G.Get_Category (Wide_Wide_Character'Pos (U)));
  43    end Get_Category;
  44
  45    --------------
  46    -- Is_Digit --
  47    --------------
  48
  49    function Is_Digit (U : Wide_Wide_Character) return Boolean is
  50    begin
  51       return G.Is_UTF_32_Digit (Wide_Wide_Character'Pos (U));
  52    end Is_Digit;
  53
  54    function Is_Digit (C : Category) return Boolean is
  55    begin
  56       return G.Is_UTF_32_Digit (G.Category (C));
  57    end Is_Digit;
  58
  59    ---------------
  60    -- Is_Letter --
  61    ---------------
  62
  63    function Is_Letter (U : Wide_Wide_Character) return Boolean is
  64    begin
  65       return G.Is_UTF_32_Letter (Wide_Wide_Character'Pos (U));
  66    end Is_Letter;
  67
  68    function Is_Letter (C : Category) return Boolean is
  69    begin
  70       return G.Is_UTF_32_Letter (G.Category (C));
  71    end Is_Letter;
  72
  73    ------------------------
  74    -- Is_Line_Terminator --
  75    ------------------------
  76
  77    function Is_Line_Terminator (U : Wide_Wide_Character) return Boolean is
  78    begin
  79       return G.Is_UTF_32_Line_Terminator (Wide_Wide_Character'Pos (U));
  80    end Is_Line_Terminator;
  81
  82    -------------
  83    -- Is_Mark --
  84    -------------
  85
  86    function Is_Mark (U : Wide_Wide_Character) return Boolean is
  87    begin
  88       return G.Is_UTF_32_Mark (Wide_Wide_Character'Pos (U));
  89    end Is_Mark;
  90
  91    function Is_Mark (C : Category) return Boolean is
  92    begin
  93       return G.Is_UTF_32_Mark (G.Category (C));
  94    end Is_Mark;
  95
  96    --------------------
  97    -- Is_Non_Graphic --
  98    --------------------
  99
 100    function Is_Non_Graphic (U : Wide_Wide_Character) return Boolean is
 101    begin
 102       return G.Is_UTF_32_Non_Graphic (Wide_Wide_Character'Pos (U));
 103    end Is_Non_Graphic;
 104
 105    function Is_Non_Graphic (C : Category) return Boolean is
 106    begin
 107       return G.Is_UTF_32_Non_Graphic (G.Category (C));
 108    end Is_Non_Graphic;
 109
 110    --------------
 111    -- Is_Other --
 112    --------------
 113
 114    function Is_Other (U : Wide_Wide_Character) return Boolean is
 115    begin
 116       return G.Is_UTF_32_Other (Wide_Wide_Character'Pos (U));
 117    end Is_Other;
 118
 119    function Is_Other (C : Category) return Boolean is
 120    begin
 121       return G.Is_UTF_32_Other (G.Category (C));
 122    end Is_Other;
 123
 124    --------------------
 125    -- Is_Punctuation --
 126    --------------------
 127
 128    function Is_Punctuation (U : Wide_Wide_Character) return Boolean is
 129    begin
 130       return G.Is_UTF_32_Punctuation (Wide_Wide_Character'Pos (U));
 131    end Is_Punctuation;
 132
 133    function Is_Punctuation (C : Category) return Boolean is
 134    begin
 135       return G.Is_UTF_32_Punctuation (G.Category (C));
 136    end Is_Punctuation;
 137
 138    --------------
 139    -- Is_Space --
 140    --------------
 141
 142    function Is_Space (U : Wide_Wide_Character) return Boolean is
 143    begin
 144       return G.Is_UTF_32_Space (Wide_Wide_Character'Pos (U));
 145    end Is_Space;
 146
 147    function Is_Space (C : Category) return Boolean is
 148    begin
 149       return G.Is_UTF_32_Space (G.Category (C));
 150    end Is_Space;
 151
 152    -------------------
 153    -- To_Lower_Case --
 154    -------------------
 155
 156    function To_Lower_Case
 157      (U : Wide_Wide_Character) return Wide_Wide_Character
 158    is
 159    begin
 160       return
 161         Wide_Wide_Character'Val
 162           (G.UTF_32_To_Lower_Case (Wide_Wide_Character'Pos (U)));
 163    end To_Lower_Case;
 164
 165    -------------------
 166    -- To_Upper_Case --
 167    -------------------
 168
 169    function To_Upper_Case
 170      (U : Wide_Wide_Character) return Wide_Wide_Character
 171    is
 172    begin
 173       return
 174         Wide_Wide_Character'Val
 175           (G.UTF_32_To_Upper_Case (Wide_Wide_Character'Pos (U)));
 176    end To_Upper_Case;
 177
 178 end Ada.Wide_Wide_Characters.Unicode;