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-2023, 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_Basic --
  47    --------------
  48
  49    function Is_Basic (U : Wide_Wide_Character) return Boolean is
  50    begin
  51       return G.Is_UTF_32_Basic (Wide_Wide_Character'Pos (U));
  52    end Is_Basic;
  53
  54    --------------
  55    -- Is_Digit --
  56    --------------
  57
  58    function Is_Digit (U : Wide_Wide_Character) return Boolean is
  59    begin
  60       return G.Is_UTF_32_Digit (Wide_Wide_Character'Pos (U));
  61    end Is_Digit;
  62
  63    function Is_Digit (C : Category) return Boolean is
  64    begin
  65       return G.Is_UTF_32_Digit (G.Category (C));
  66    end Is_Digit;
  67
  68    ---------------
  69    -- Is_Letter --
  70    ---------------
  71
  72    function Is_Letter (U : Wide_Wide_Character) return Boolean is
  73    begin
  74       return G.Is_UTF_32_Letter (Wide_Wide_Character'Pos (U));
  75    end Is_Letter;
  76
  77    function Is_Letter (C : Category) return Boolean is
  78    begin
  79       return G.Is_UTF_32_Letter (G.Category (C));
  80    end Is_Letter;
  81
  82    ------------------------
  83    -- Is_Line_Terminator --
  84    ------------------------
  85
  86    function Is_Line_Terminator (U : Wide_Wide_Character) return Boolean is
  87    begin
  88       return G.Is_UTF_32_Line_Terminator (Wide_Wide_Character'Pos (U));
  89    end Is_Line_Terminator;
  90
  91    -------------
  92    -- Is_Mark --
  93    -------------
  94
  95    function Is_Mark (U : Wide_Wide_Character) return Boolean is
  96    begin
  97       return G.Is_UTF_32_Mark (Wide_Wide_Character'Pos (U));
  98    end Is_Mark;
  99
 100    function Is_Mark (C : Category) return Boolean is
 101    begin
 102       return G.Is_UTF_32_Mark (G.Category (C));
 103    end Is_Mark;
 104
 105    --------------------
 106    -- Is_Non_Graphic --
 107    --------------------
 108
 109    function Is_Non_Graphic (U : Wide_Wide_Character) return Boolean is
 110    begin
 111       return G.Is_UTF_32_Non_Graphic (Wide_Wide_Character'Pos (U));
 112    end Is_Non_Graphic;
 113
 114    function Is_Non_Graphic (C : Category) return Boolean is
 115    begin
 116       return G.Is_UTF_32_Non_Graphic (G.Category (C));
 117    end Is_Non_Graphic;
 118
 119    -------------
 120    -- Is_NFKC --
 121    -------------
 122
 123    function Is_NFKC (U : Wide_Wide_Character) return Boolean is
 124    begin
 125       return G.Is_UTF_32_NFKC (Wide_Wide_Character'Pos (U));
 126    end Is_NFKC;
 127
 128    --------------
 129    -- Is_Other --
 130    --------------
 131
 132    function Is_Other (U : Wide_Wide_Character) return Boolean is
 133    begin
 134       return G.Is_UTF_32_Other (Wide_Wide_Character'Pos (U));
 135    end Is_Other;
 136
 137    function Is_Other (C : Category) return Boolean is
 138    begin
 139       return G.Is_UTF_32_Other (G.Category (C));
 140    end Is_Other;
 141
 142    --------------------
 143    -- Is_Punctuation --
 144    --------------------
 145
 146    function Is_Punctuation (U : Wide_Wide_Character) return Boolean is
 147    begin
 148       return G.Is_UTF_32_Punctuation (Wide_Wide_Character'Pos (U));
 149    end Is_Punctuation;
 150
 151    function Is_Punctuation (C : Category) return Boolean is
 152    begin
 153       return G.Is_UTF_32_Punctuation (G.Category (C));
 154    end Is_Punctuation;
 155
 156    --------------
 157    -- Is_Space --
 158    --------------
 159
 160    function Is_Space (U : Wide_Wide_Character) return Boolean is
 161    begin
 162       return G.Is_UTF_32_Space (Wide_Wide_Character'Pos (U));
 163    end Is_Space;
 164
 165    function Is_Space (C : Category) return Boolean is
 166    begin
 167       return G.Is_UTF_32_Space (G.Category (C));
 168    end Is_Space;
 169
 170    --------------
 171    -- To_Basic --
 172    --------------
 173
 174    function To_Basic (U : Wide_Wide_Character) return Wide_Wide_Character is
 175    begin
 176       return Wide_Wide_Character'Val
 177         (G.UTF_32_To_Basic (Wide_Wide_Character'Pos (U)));
 178    end To_Basic;
 179
 180    -------------------
 181    -- To_Lower_Case --
 182    -------------------
 183
 184    function To_Lower_Case
 185      (U : Wide_Wide_Character) return Wide_Wide_Character
 186    is
 187    begin
 188       return
 189         Wide_Wide_Character'Val
 190           (G.UTF_32_To_Lower_Case (Wide_Wide_Character'Pos (U)));
 191    end To_Lower_Case;
 192
 193    -------------------
 194    -- To_Upper_Case --
 195    -------------------
 196
 197    function To_Upper_Case
 198      (U : Wide_Wide_Character) return Wide_Wide_Character
 199    is
 200    begin
 201       return
 202         Wide_Wide_Character'Val
 203           (G.UTF_32_To_Upper_Case (Wide_Wide_Character'Pos (U)));
 204    end To_Upper_Case;
 205
 206 end Ada.Wide_Wide_Characters.Unicode;