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-2020, 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
32package 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_NFKC --
112   -------------
113
114   function Is_NFKC (U : Wide_Wide_Character) return Boolean is
115   begin
116      return G.Is_UTF_32_NFKC (Wide_Wide_Character'Pos (U));
117   end Is_NFKC;
118
119   --------------
120   -- Is_Other --
121   --------------
122
123   function Is_Other (U : Wide_Wide_Character) return Boolean is
124   begin
125      return G.Is_UTF_32_Other (Wide_Wide_Character'Pos (U));
126   end Is_Other;
127
128   function Is_Other (C : Category) return Boolean is
129   begin
130      return G.Is_UTF_32_Other (G.Category (C));
131   end Is_Other;
132
133   --------------------
134   -- Is_Punctuation --
135   --------------------
136
137   function Is_Punctuation (U : Wide_Wide_Character) return Boolean is
138   begin
139      return G.Is_UTF_32_Punctuation (Wide_Wide_Character'Pos (U));
140   end Is_Punctuation;
141
142   function Is_Punctuation (C : Category) return Boolean is
143   begin
144      return G.Is_UTF_32_Punctuation (G.Category (C));
145   end Is_Punctuation;
146
147   --------------
148   -- Is_Space --
149   --------------
150
151   function Is_Space (U : Wide_Wide_Character) return Boolean is
152   begin
153      return G.Is_UTF_32_Space (Wide_Wide_Character'Pos (U));
154   end Is_Space;
155
156   function Is_Space (C : Category) return Boolean is
157   begin
158      return G.Is_UTF_32_Space (G.Category (C));
159   end Is_Space;
160
161   -------------------
162   -- To_Lower_Case --
163   -------------------
164
165   function To_Lower_Case
166     (U : Wide_Wide_Character) return Wide_Wide_Character
167   is
168   begin
169      return
170        Wide_Wide_Character'Val
171          (G.UTF_32_To_Lower_Case (Wide_Wide_Character'Pos (U)));
172   end To_Lower_Case;
173
174   -------------------
175   -- To_Upper_Case --
176   -------------------
177
178   function To_Upper_Case
179     (U : Wide_Wide_Character) return Wide_Wide_Character
180   is
181   begin
182      return
183        Wide_Wide_Character'Val
184          (G.UTF_32_To_Upper_Case (Wide_Wide_Character'Pos (U)));
185   end To_Upper_Case;
186
187end Ada.Wide_Wide_Characters.Unicode;
188