From 8c77e8b09ef271c10f89161591e8eb162c579f4b Mon Sep 17 00:00:00 2001 From: Etienne Servais Date: Fri, 17 Sep 2021 12:29:46 +0200 Subject: [PATCH] [Ada] Add missing functions to Wide_Wide_Characters Handling gcc/ada/ * libgnat/a-zchhan.ads, libgnat/a-zchhan.adb (Character_Set_Version, Is_Basic, To_Basic): New. * libgnat/a-zchuni.ads, libgnat/a-zchuni.adb (Is_Basic, To_Basic): New. --- gcc/ada/libgnat/a-zchhan.adb | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/libgnat/a-zchhan.ads | 29 +++++++++++++++++++++++++---- gcc/ada/libgnat/a-zchuni.adb | 19 +++++++++++++++++++ gcc/ada/libgnat/a-zchuni.ads | 12 ++++++++++++ 4 files changed, 90 insertions(+), 4 deletions(-) diff --git a/gcc/ada/libgnat/a-zchhan.adb b/gcc/ada/libgnat/a-zchhan.adb index 3f2a91b..61405f7 100644 --- a/gcc/ada/libgnat/a-zchhan.adb +++ b/gcc/ada/libgnat/a-zchhan.adb @@ -33,6 +33,15 @@ with Ada.Wide_Wide_Characters.Unicode; use Ada.Wide_Wide_Characters.Unicode; package body Ada.Wide_Wide_Characters.Handling is + --------------------------- + -- Character_Set_Version -- + --------------------------- + + function Character_Set_Version return String is + begin + return "Unicode 4.0"; + end Character_Set_Version; + --------------------- -- Is_Alphanumeric -- --------------------- @@ -42,6 +51,13 @@ package body Ada.Wide_Wide_Characters.Handling is return Is_Letter (Item) or else Is_Digit (Item); end Is_Alphanumeric; + -------------- + -- Is_Basic -- + -------------- + + function Is_Basic (Item : Wide_Wide_Character) return Boolean + renames Ada.Wide_Wide_Characters.Unicode.Is_Basic; + ---------------- -- Is_Control -- ---------------- @@ -191,4 +207,22 @@ package body Ada.Wide_Wide_Characters.Handling is return Result; end To_Upper; + -------------- + -- To_Basic -- + -------------- + + function To_Basic (Item : Wide_Wide_Character) return Wide_Wide_Character + renames Ada.Wide_Wide_Characters.Unicode.To_Basic; + + function To_Basic (Item : Wide_Wide_String) return Wide_Wide_String is + Result : Wide_Wide_String (Item'Range); + + begin + for J in Result'Range loop + Result (J) := To_Basic (Item (J)); + end loop; + + return Result; + end To_Basic; + end Ada.Wide_Wide_Characters.Handling; diff --git a/gcc/ada/libgnat/a-zchhan.ads b/gcc/ada/libgnat/a-zchhan.ads index 74fab2a..6ebd1a8 100644 --- a/gcc/ada/libgnat/a-zchhan.ads +++ b/gcc/ada/libgnat/a-zchhan.ads @@ -15,10 +15,12 @@ package Ada.Wide_Wide_Characters.Handling is pragma Pure; - -- This package is clearly intended to be Pure, by analogy with the - -- base Ada.Characters.Handling package. The version in the RM does - -- not yet have this pragma, but that is a clear omission. This will - -- be fixed in a future version of AI05-0266-1. + + function Character_Set_Version return String; + pragma Inline (Character_Set_Version); + -- Returns an implementation-defined identifier that identifies the version + -- of the character set standard that is used for categorizing characters + -- by the implementation. For GNAT this is "Unicode v.v". function Is_Control (Item : Wide_Wide_Character) return Boolean; pragma Inline (Is_Control); @@ -42,6 +44,12 @@ package Ada.Wide_Wide_Characters.Handling is -- Returns True if the Wide_Wide_Character designated by Item is -- categorized as letter_uppercase, otherwise returns false. + function Is_Basic (Item : Wide_Wide_Character) return Boolean; + pragma Inline (Is_Basic); + -- Returns True if the Wide_Wide_Character designated by Item has no + -- Decomposition Mapping in the code charts of ISO/IEC 10646:2017, + -- otherwise returns False. + function Is_Digit (Item : Wide_Wide_Character) return Boolean; pragma Inline (Is_Digit); -- Returns True if the Wide_Wide_Character designated by Item is @@ -135,4 +143,17 @@ package Ada.Wide_Wide_Characters.Handling is -- designated by Item. The result is the null Wide_Wide_String if the value -- of the formal parameter is the null Wide_Wide_String. + function To_Basic (Item : Wide_Wide_Character) return Wide_Wide_Character; + pragma Inline (To_Basic); + -- Returns the Wide_Wide_Character whose code point is given + -- by the first value of its Decomposition Mapping in the code charts + -- of ISO/IEC 10646:2017 if any, returns Item otherwise. + + function To_Basic (Item : Wide_Wide_String) return Wide_Wide_String; + -- Returns the result of applying the To_Basic conversion to each + -- Wide_Wide_Character element of the Wide_Wide_String designated by Item. + -- The result is the null Wide_Wide_String if the value of the formal + -- parameter is the null Wide_Wide_String. The lower bound of the result + -- Wide_Wide_String is 1. + end Ada.Wide_Wide_Characters.Handling; diff --git a/gcc/ada/libgnat/a-zchuni.adb b/gcc/ada/libgnat/a-zchuni.adb index 2bbe584..3c6e720 100644 --- a/gcc/ada/libgnat/a-zchuni.adb +++ b/gcc/ada/libgnat/a-zchuni.adb @@ -43,6 +43,15 @@ package body Ada.Wide_Wide_Characters.Unicode is end Get_Category; -------------- + -- Is_Basic -- + -------------- + + function Is_Basic (U : Wide_Wide_Character) return Boolean is + begin + return G.Is_UTF_32_Basic (Wide_Wide_Character'Pos (U)); + end Is_Basic; + + -------------- -- Is_Digit -- -------------- @@ -158,6 +167,16 @@ package body Ada.Wide_Wide_Characters.Unicode is return G.Is_UTF_32_Space (G.Category (C)); end Is_Space; + -------------- + -- To_Basic -- + -------------- + + function To_Basic (U : Wide_Wide_Character) return Wide_Wide_Character is + begin + return Wide_Wide_Character'Val + (G.UTF_32_To_Basic (Wide_Wide_Character'Pos (U))); + end To_Basic; + ------------------- -- To_Lower_Case -- ------------------- diff --git a/gcc/ada/libgnat/a-zchuni.ads b/gcc/ada/libgnat/a-zchuni.ads index 51f7c92..0030fd1 100644 --- a/gcc/ada/libgnat/a-zchuni.ads +++ b/gcc/ada/libgnat/a-zchuni.ads @@ -177,6 +177,18 @@ package Ada.Wide_Wide_Characters.Unicode is -- in the list of categories above. This means that these characters can -- be included in character and string literals. + function Is_Basic (U : Wide_Wide_Character) return Boolean; + pragma Inline (Is_Basic); + -- Returns True if the Wide_Wide_Character designated by Item has no + -- Decomposition Mapping in the code charts of ISO/IEC 10646:2017, + -- otherwise returns False. + + function To_Basic (U : Wide_Wide_Character) return Wide_Wide_Character; + pragma Inline (To_Basic); + -- Returns the Wide_Wide_Character whose code point is given by the first + -- value of its Decomposition Mapping in the code charts of + -- ISO/IEC 10646:2017 if any, returns Item otherwise. + -- The following function is used to fold to upper case, as required by -- the Ada 2005 standard rules for identifier case folding. Two -- identifiers are equivalent if they are identical after folding all -- 2.7.4