diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index f71bc11f..296a213a 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -311,15 +311,14 @@ build_lsif: rules: - if: $CI_PIPELINE_SOURCE == 'merge_request_event' when: manual + allow_failure: true trigger: strategy: depend inherit: variables: false variables: - ACI_UPSTREAM_PROJECT_PATH: $CI_PROJECT_PATH - ACI_UPSTREAM_REF_NAME: $CI_COMMIT_REF_NAME - ACI_UPSTREAM_SOURCE_BRANCH: $CI_MERGE_REQUEST_SOURCE_BRANCH_NAME - ACI_UPSTREAM_TARGET_BRANCH: $CI_MERGE_REQUEST_TARGET_BRANCH_NAME + ACI_UPSTREAM_PROJECT_ID: $CI_PROJECT_ID + ACI_UPSTREAM_MERGE_REQUEST_IID: $CI_MERGE_REQUEST_IID run_als_ci: <<: *run_ci_common diff --git a/Makefile b/Makefile index 3c5710ec..cc5f0622 100644 --- a/Makefile +++ b/Makefile @@ -80,23 +80,19 @@ check_text: .objs/tests/test_text_streams .objs/tests/test_file_text_streams testsuite/stream/test_file_text_stream/vss.197.in.txt /tmp/vss.197.out.txt && diff -u /tmp/vss.197.out.txt testsuite/stream/test_file_text_stream/vss.197.out.txt .objs/tests/test_string_append - .objs/tests/test_string_casing .objs/tests/test_string_compare .objs/tests/test_string_conversions .objs/tests/test_string_delete .objs/tests/test_string_hash .objs/tests/test_string_insert .objs/tests/test_string_buffer - .objs/tests/test_string_normalization data/ucd .objs/tests/test_string_slice .objs/tests/test_string_split .objs/tests/test_string_split_lines .objs/tests/test_string .objs/tests/test_string_template .objs/tests/test_string_vector - for f in testsuite/text/w3c-i18n-tests-casing/*.txt; do \ - echo " $$f"; .objs/tests/test_string_casing_w3c_i18n $$f || return 1; \ - done + .objs/tests/test_transformer data/ucd testsuite/text/w3c-i18n-tests-casing/*.txt .objs/tests/test_word_iterators data/ucd .objs/tests/test_standard_paths ifeq ($(OS),Windows_NT) diff --git a/gnat/tests/vss_text_tests.gpr b/gnat/tests/vss_text_tests.gpr index 2ed44014..e9655d03 100644 --- a/gnat/tests/vss_text_tests.gpr +++ b/gnat/tests/vss_text_tests.gpr @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 -- @@ -26,8 +26,6 @@ project VSS_Text_Tests is "test_line_iterators.adb", "test_string", "test_string_append", - "test_string_casing.adb", - "test_string_casing_w3c_i18n.adb", "test_string_compare", "test_string_conversions.adb", "test_string_decoder.adb", @@ -35,12 +33,12 @@ project VSS_Text_Tests is "test_string_hash", "test_string_insert", "test_string_buffer", - "test_string_normalization", "test_string_slice", "test_string_split", "test_string_split_lines", "test_string_template", "test_string_vector", + "test_transformer", "test_word_iterators"); package Compiler is diff --git a/source/regexp/implementation/vss-regular_expressions-name_sets.adb b/source/regexp/implementation/vss-regular_expressions-name_sets.adb index 7633e89d..8166e43b 100644 --- a/source/regexp/implementation/vss-regular_expressions-name_sets.adb +++ b/source/regexp/implementation/vss-regular_expressions-name_sets.adb @@ -1,9 +1,11 @@ -- --- Copyright (C) 2022-2023, AdaCore +-- Copyright (C) 2022-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- +with VSS.Transformers.Casing; + with VSS.Regular_Expressions.Category_Maps; package body VSS.Regular_Expressions.Name_Sets is @@ -60,7 +62,9 @@ package body VSS.Regular_Expressions.Name_Sets is Initialize; end if; - Cursor := Map.Find (Name.To_Simple_Lowercase); + Cursor := + Map.Find + (VSS.Transformers.Casing.To_Simple_Lowercase.Transform (Name)); if Category_Maps.Maps.Has_Element (Cursor) then Value := Category_Maps.Maps.Element (Cursor); diff --git a/source/text/implementation/vss-strings-internals.adb b/source/text/implementation/vss-strings-internals.adb index 9b2c19c3..9739bb8f 100644 --- a/source/text/implementation/vss-strings-internals.adb +++ b/source/text/implementation/vss-strings-internals.adb @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2022, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -17,6 +17,19 @@ package body VSS.Strings.Internals is return Self.Data'Unchecked_Access; end Data_Access_Constant; + ----------------- + -- Set_By_Move -- + ----------------- + + procedure Set_By_Move + (Self : in out VSS.Strings.Virtual_String'Class; + To : in out VSS.Implementation.Strings.String_Data) is + begin + VSS.Implementation.Strings.Unreference (Self.Data); + Self.Data := To; + To := (others => <>); + end Set_By_Move; + ---------------------------- -- To_Magic_String_Access -- ---------------------------- diff --git a/source/text/implementation/vss-strings-internals.ads b/source/text/implementation/vss-strings-internals.ads index ded69e8b..d2a351d2 100644 --- a/source/text/implementation/vss-strings-internals.ads +++ b/source/text/implementation/vss-strings-internals.ads @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2022, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -33,6 +33,12 @@ package VSS.Strings.Internals is return not null VSS.Strings.Internals.String_Data_Constant_Access; -- Return access to string data member of the Virtual_String. + procedure Set_By_Move + (Self : in out VSS.Strings.Virtual_String'Class; + To : in out VSS.Implementation.Strings.String_Data); + -- Set given string to given data. Initial data of the Self is + -- unreferenced, given data is copied and given value is reset. + function To_Virtual_String_Access (Item : VSS.Implementation.Referrers.Magic_String_Access) return VSS.Implementation.Referrers.Virtual_String_Access with Inline; @@ -40,6 +46,6 @@ package VSS.Strings.Internals is (Item : VSS.Implementation.Referrers.Virtual_String_Access) return VSS.Implementation.Referrers.Magic_String_Access with Inline; -- Do type conversion. It is intended to be used inside the - -- VSS.Implementation.Refrrals package. + -- VSS.Implementation.Referrals package. end VSS.Strings.Internals; diff --git a/source/text/implementation/vss-strings.adb b/source/text/implementation/vss-strings.adb index 56775084..8d93e4cf 100644 --- a/source/text/implementation/vss-strings.adb +++ b/source/text/implementation/vss-strings.adb @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -17,6 +17,7 @@ with VSS.Strings.Cursors.Iterators.Grapheme_Clusters; with VSS.Strings.Cursors.Iterators.Lines; with VSS.Strings.Cursors.Iterators.Words; with VSS.String_Vectors.Internals; +with VSS.Transformers; package body VSS.Strings is @@ -1231,108 +1232,6 @@ package body VSS.Strings is end return; end Tail_From; - ------------------ - -- To_Lowercase -- - ------------------ - - function To_Lowercase (Self : Virtual_String'Class) return Virtual_String is - begin - return Result : Virtual_String do - VSS.Implementation.UTF8_Casing.Convert_Case - (Self.Data, - VSS.Implementation.UTF8_Casing.Lowercase, - Result.Data); - end return; - end To_Lowercase; - - ------------------- - -- To_Normalized -- - ------------------- - - function To_Normalized - (Self : Virtual_String'Class; - Form : Normalization_Form) return Virtual_String is - begin - return Result : Virtual_String do - VSS.Implementation.UTF8_Normalization.Normalize - (Self.Data, Form, Result.Data); - end return; - end To_Normalized; - - ------------------------- - -- To_Simple_Lowercase -- - ------------------------- - - function To_Simple_Lowercase - (Self : Virtual_String'Class) return Virtual_String is - begin - return Result : Virtual_String do - VSS.Implementation.UTF8_Casing.Convert_Case - (Self.Data, - VSS.Implementation.UTF8_Casing.Simple_Lowercase, - Result.Data); - end return; - end To_Simple_Lowercase; - - ------------------------- - -- To_Simple_Titlecase -- - ------------------------- - --- function To_Simple_Titlecase --- (Self : Virtual_String'Class) return Virtual_String is --- begin --- return Result : Virtual_String do --- VSS.Implementation.Strings.Handler (Self.Data).Convert_Case --- (Self.Data, --- VSS.Implementation.String_Handlers.Simple_Titlecase, --- Result.Data); --- end return; --- end To_Simple_Titlecase; - - ------------------------- - -- To_Simple_Uppercase -- - ------------------------- - - function To_Simple_Uppercase - (Self : Virtual_String'Class) return Virtual_String is - begin - return Result : Virtual_String do - VSS.Implementation.UTF8_Casing.Convert_Case - (Self.Data, - VSS.Implementation.UTF8_Casing.Simple_Uppercase, - Result.Data); - end return; - end To_Simple_Uppercase; - - ------------------ - -- To_Titlecase -- - ------------------ - --- function To_Titlecase --- (Self : Virtual_String'Class) return Virtual_String is --- begin --- return Result : Virtual_String do --- VSS.Implementation.Strings.Handler (Self.Data).Convert_Case --- (Self.Data, --- VSS.Implementation.String_Handlers.Titlecase, --- Result.Data); --- end return; --- end To_Titlecase; - - ------------------ - -- To_Uppercase -- - ------------------ - - function To_Uppercase (Self : Virtual_String'Class) return Virtual_String is - begin - return Result : Virtual_String do - VSS.Implementation.UTF8_Casing.Convert_Case - (Self.Data, - VSS.Implementation.UTF8_Casing.Uppercase, - Result.Data); - end return; - end To_Uppercase; - ----------------------- -- To_Virtual_String -- ----------------------- @@ -1367,6 +1266,29 @@ package body VSS.Strings is end return; end To_Virtual_String; + --------------- + -- Transform -- + --------------- + + function Transform + (Self : Virtual_String'Class; + Transformer : VSS.Transformers.Abstract_Transformer'Class) + return Virtual_String is + begin + return Transformer.Transform (Self); + end Transform; + + --------------- + -- Transform -- + --------------- + + procedure Transform + (Self : in out Virtual_String'Class; + Transformer : VSS.Transformers.Abstract_Transformer'Class) is + begin + Transformer.Transform (Self); + end Transform; + ----------- -- Write -- ----------- diff --git a/source/text/implementation/vss-transformers-casing.adb b/source/text/implementation/vss-transformers-casing.adb new file mode 100644 index 00000000..c927cbcc --- /dev/null +++ b/source/text/implementation/vss-transformers-casing.adb @@ -0,0 +1,185 @@ +-- +-- Copyright (C) 2023-2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +with VSS.Implementation.Strings; +with VSS.Implementation.UTF8_Casing; +with VSS.Strings.Internals; + +package body VSS.Transformers.Casing is + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Lowercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Lowercase, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Lowercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Lowercase, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Simple_Lowercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Simple_Lowercase, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Simple_Lowercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Simple_Lowercase, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Simple_Uppercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Simple_Uppercase, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Simple_Uppercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Simple_Uppercase, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Uppercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Uppercase, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Uppercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Casing.Convert_Case + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Implementation.UTF8_Casing.Uppercase, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + +end VSS.Transformers.Casing; diff --git a/source/text/implementation/vss-transformers-normalization.adb b/source/text/implementation/vss-transformers-normalization.adb new file mode 100644 index 00000000..cab49945 --- /dev/null +++ b/source/text/implementation/vss-transformers-normalization.adb @@ -0,0 +1,185 @@ +-- +-- Copyright (C) 2023-2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +with VSS.Implementation.Strings; +with VSS.Implementation.UTF8_Normalization; +with VSS.Strings.Internals; + +package body VSS.Transformers.Normalization is + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Normalization_Form_C_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_C, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Normalization_Form_C_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_C, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Normalization_Form_D_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_D, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Normalization_Form_D_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_D, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Normalization_Form_KC_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_KC, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Normalization_Form_KC_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_KC, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding function Transform + (Self : Normalization_Form_KD_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_KD, + Aux); + + return Result : constant VSS.Strings.Virtual_String := + VSS.Strings.Internals.To_Virtual_String (Aux) + do + VSS.Implementation.Strings.Unreference (Aux); + end return; + end Transform; + + --------------- + -- Transform -- + --------------- + + overriding procedure Transform + (Self : Normalization_Form_KD_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) + is + Aux : VSS.Implementation.Strings.String_Data; + + begin + VSS.Implementation.UTF8_Normalization.Normalize + (VSS.Strings.Internals.Data_Access_Constant (Item).all, + VSS.Strings.Normalization_Form_KD, + Aux); + + VSS.Strings.Internals.Set_By_Move (Item, Aux); + end Transform; + +end VSS.Transformers.Normalization; diff --git a/source/text/vss-strings.ads b/source/text/vss-strings.ads index 69a824b6..3620f1e2 100644 --- a/source/text/vss-strings.ads +++ b/source/text/vss-strings.ads @@ -1,5 +1,5 @@ -- --- Copyright (C) 2020-2023, AdaCore +-- Copyright (C) 2020-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- @@ -19,6 +19,7 @@ limited with VSS.Strings.Cursors.Iterators.Characters; limited with VSS.Strings.Cursors.Iterators.Grapheme_Clusters; limited with VSS.Strings.Cursors.Iterators.Lines; limited with VSS.Strings.Cursors.Iterators.Words; +limited with VSS.Transformers; package VSS.Strings is @@ -388,6 +389,8 @@ package VSS.Strings is -- Return True when Self starts with Prefix. Case_Sensitivity defines -- whether search is case sensitive or not, and select algorithm for the -- last. + -- + -- XXX Don't use Case_Sensitivity parameter, it will be removed. function Ends_With (Self : Virtual_String'Class; @@ -397,6 +400,8 @@ package VSS.Strings is -- Return True when Self has given Suffix. Case_Sensitivity defines -- whether search is case sensitive or not, and select algorithm for the -- last. + -- + -- XXX Don't use Case_Sensitivity parameter, it will be removed. function Ends_With (Self : Virtual_String'Class; @@ -430,45 +435,21 @@ package VSS.Strings is Keep_Terminator : Boolean := False) return VSS.String_Vectors.Virtual_String_Vector; - function To_Lowercase (Self : Virtual_String'Class) return Virtual_String; - -- Convert string to lowercase form using default full case conversion. - -- - -- See VSS.Locales.To_Lowercase for case conversions with tailoring by - -- the locale. - --- function To_Titlecase (Self : Virtual_String'Class) return Virtual_String; --- -- Convert string to titlecase form using default full case conversion. --- -- --- -- See VSS.Locales.To_Titlecase for case conversions with tailoring by --- -- the locale. - - function To_Uppercase (Self : Virtual_String'Class) return Virtual_String; - -- Convert string to uppercase form using default full case conversion. - -- - -- See VSS.Locales.To_Uppercase for case conversions with tailoring by - -- the locale. - - function To_Simple_Lowercase - (Self : Virtual_String'Class) return Virtual_String; - -- Convert string to lowercase form using default simple case conversion. - --- function To_Simple_Titlecase --- (Self : Virtual_String'Class) return Virtual_String; --- -- Convert string to titlecase form using default simple case conversion. - - function To_Simple_Uppercase - (Self : Virtual_String'Class) return Virtual_String; - -- Convert string to uppercase form using default simple case conversion. - - function To_Normalized - (Self : Virtual_String'Class; - Form : Normalization_Form) return Virtual_String; - -- Convert string to given normalization form. - procedure Put_Image (Buffer : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; Item : Virtual_String); + function Transform + (Self : Virtual_String'Class; + Transformer : VSS.Transformers.Abstract_Transformer'Class) + return Virtual_String; + -- Transform given text using given text transformer. + + procedure Transform + (Self : in out Virtual_String'Class; + Transformer : VSS.Transformers.Abstract_Transformer'Class); + -- Transform given text using given text transformer. + private type Magic_String_Access is access all Virtual_String'Class; diff --git a/source/text/vss-transformers-casing.ads b/source/text/vss-transformers-casing.ads new file mode 100644 index 00000000..4d121b3b --- /dev/null +++ b/source/text/vss-transformers-casing.ads @@ -0,0 +1,111 @@ +-- +-- Copyright (C) 2023-2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +-- Unicode default case conversion. +-- +-- For locale tailored case conversion see VSS.Locales. + +with VSS.Strings; + +package VSS.Transformers.Casing is + + pragma Preelaborate; + + -- XXX GNAT 20231112 All types need to be make publicaly declared and + -- constants are declared as constants of that type (not classwide type + -- of base type) + -- + -- Lowercase : constant Abstract_Transformer'Class; + -- -- Convert text to lowercase using default full case conversion. + -- + -- Uppercase : constant Abstract_Transformer'Class; + -- -- Convert text to uppercase using default full case conversion. + -- + -- Simple_Lowercase : constant Abstract_Transformer'Class; + -- -- Convert text to lowercase using default simple case conversion. + -- + -- Simple_Uppercase : constant Abstract_Transformer'Class; + -- -- Convert text to uppercase using default simple case conversion. + + type Simple_Lowercase_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Simple_Lowercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Simple_Lowercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + type Simple_Uppercase_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Simple_Uppercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Simple_Uppercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + type Lowercase_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Lowercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Lowercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + type Uppercase_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Uppercase_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Uppercase_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + To_Lowercase : constant Lowercase_Transformer := + Lowercase_Transformer'(null record); + To_Simple_Lowercase : constant Simple_Lowercase_Transformer := + Simple_Lowercase_Transformer'(null record); + To_Simple_Uppercase : constant Simple_Uppercase_Transformer := + Simple_Uppercase_Transformer'(null record); + To_Uppercase : constant Uppercase_Transformer := + Uppercase_Transformer'(null record); + + -- Lowercase : constant Abstract_Transformer'Class := + -- Lowercase_Transformer'(null record); + -- Simple_Lowercase : constant Abstract_Transformer'Class := + -- Simple_Lowercase_Transformer'(null record); + -- Simple_Uppercase : constant Abstract_Transformer'Class := + -- Simple_Uppercase_Transformer'(null record); + -- Uppercase : constant Abstract_Transformer'Class := + -- Uppercase_Transformer'(null record); + +end VSS.Transformers.Casing; diff --git a/source/text/vss-transformers-normalization.ads b/source/text/vss-transformers-normalization.ads new file mode 100644 index 00000000..fc146d30 --- /dev/null +++ b/source/text/vss-transformers-normalization.ads @@ -0,0 +1,109 @@ +-- +-- Copyright (C) 2023-2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +-- Unicode Normalization transformations. + +with VSS.Strings; + +package VSS.Transformers.Normalization is + + pragma Preelaborate; + + -- XXX GNAT 20231112 All types need to be make publicaly declared and + -- constants are declared as constants of that type (not classwide type + -- of base type) + -- + -- Normalization_Form_D : constant Abstract_Transformer'Class; + -- -- Transform text to Normalization Form D. + -- + -- Normalization_Form_C : constant Abstract_Transformer'Class; + -- -- Transform text to Normalization Form C. + -- + -- Normalization_Form_KD : constant Abstract_Transformer'Class; + -- -- Transform text to Normalization Form KD. + -- + -- Normalization_Form_KC : constant Abstract_Transformer'Class; + -- -- Transform text to Normalization Form KC. + + type Normalization_Form_D_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Normalization_Form_D_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Normalization_Form_D_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + type Normalization_Form_C_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Normalization_Form_C_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Normalization_Form_C_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + type Normalization_Form_KD_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Normalization_Form_KD_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Normalization_Form_KD_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + type Normalization_Form_KC_Transformer is + limited new Abstract_Transformer with null record; + -- @private + + overriding function Transform + (Self : Normalization_Form_KC_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String; + -- @private + + overriding procedure Transform + (Self : Normalization_Form_KC_Transformer; + Item : in out VSS.Strings.Virtual_String'Class); + -- @private + + To_Normalization_Form_D : constant Normalization_Form_D_Transformer := + Normalization_Form_D_Transformer'(null record); + To_Normalization_Form_C : constant Normalization_Form_C_Transformer := + Normalization_Form_C_Transformer'(null record); + To_Normalization_Form_KD : constant Normalization_Form_KD_Transformer := + Normalization_Form_KD_Transformer'(null record); + To_Normalization_Form_KC : constant Normalization_Form_KC_Transformer := + Normalization_Form_KC_Transformer'(null record); + + -- Normalization_Form_D : constant Abstract_Transformer'Class := + -- Normalization_Form_D_Transformer'(null record); + -- Normalization_Form_C : constant Abstract_Transformer'Class := + -- Normalization_Form_C_Transformer'(null record); + -- Normalization_Form_KD : constant Abstract_Transformer'Class := + -- Normalization_Form_KD_Transformer'(null record); + -- Normalization_Form_KC : constant Abstract_Transformer'Class := + -- Normalization_Form_KC_Transformer'(null record); + +end VSS.Transformers.Normalization; diff --git a/source/text/vss-transformers.ads b/source/text/vss-transformers.ads new file mode 100644 index 00000000..accf625f --- /dev/null +++ b/source/text/vss-transformers.ads @@ -0,0 +1,26 @@ +-- +-- Copyright (C) 2023-2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +-- Generic API to transform text data. + +with VSS.Strings; + +package VSS.Transformers is + + pragma Preelaborate; + + type Abstract_Transformer is limited interface; + + not overriding function Transform + (Self : Abstract_Transformer; + Item : VSS.Strings.Virtual_String'Class) + return VSS.Strings.Virtual_String is abstract; + + not overriding procedure Transform + (Self : Abstract_Transformer; + Item : in out VSS.Strings.Virtual_String'Class) is abstract; + +end VSS.Transformers; diff --git a/testsuite/text/test_string_casing.adb b/testsuite/text/test_transformer-test_casing_minimal.adb similarity index 57% rename from testsuite/text/test_string_casing.adb rename to testsuite/text/test_transformer-test_casing_minimal.adb index 49896658..af82dc92 100644 --- a/testsuite/text/test_string_casing.adb +++ b/testsuite/text/test_transformer-test_casing_minimal.adb @@ -1,14 +1,13 @@ -- --- Copyright (C) 2021, AdaCore +-- Copyright (C) 2021-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- -with VSS.Strings; +with VSS.Transformers.Casing; -with Test_Support; - -procedure Test_String_Casing is +separate (Test_Transformer) +procedure Test_Casing_Minimal is use type VSS.Strings.Virtual_String; S1 : constant VSS.Strings.Virtual_String := "123ABCАБВ"; @@ -55,25 +54,39 @@ procedure Test_String_Casing is VSS.Strings.Empty_Virtual_String; begin - Test_Support.Assert (S1.To_Lowercase = E1); - Test_Support.Assert (S1S.To_Lowercase = S1E); - Test_Support.Assert (S2S.To_Lowercase = S2E); - Test_Support.Assert (S3S.To_Lowercase = S3E); - Test_Support.Assert (S4S.To_Lowercase = S4E); - Test_Support.Assert (S5S.To_Lowercase = S5E); - Test_Support.Assert (S6S.To_Lowercase = S6E); - - Test_Support.Assert (U1.To_Lowercase = L1); - Test_Support.Assert (L1.To_Uppercase = U1); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S1) = E1); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S1S) = S1E); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S2S) = S2E); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S3S) = S3E); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S4S) = S4E); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S5S) = S5E); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (S6S) = S6E); + + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (U1) = L1); + Test_Support.Assert + (VSS.Transformers.Casing.To_Uppercase.Transform (L1) = U1); -- Test for null string for code coverage of Null_String_Handler. - Test_Support.Assert (SN.To_Lowercase = SN); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (SN) = SN); -- Test of simple case conversion. - Test_Support.Assert (S1.To_Simple_Lowercase = E1); - Test_Support.Assert (E1.To_Simple_Uppercase = S1); - Test_Support.Assert (U1.To_Simple_Lowercase = L1); - Test_Support.Assert (L1.To_Simple_Uppercase = U1); -end Test_String_Casing; + Test_Support.Assert + (VSS.Transformers.Casing.To_Simple_Lowercase.Transform (S1) = E1); + Test_Support.Assert + (VSS.Transformers.Casing.To_Simple_Uppercase.Transform (E1) = S1); + Test_Support.Assert + (VSS.Transformers.Casing.To_Simple_Lowercase.Transform (U1) = L1); + Test_Support.Assert + (VSS.Transformers.Casing.To_Simple_Uppercase.Transform (L1) = U1); +end Test_Casing_Minimal; diff --git a/testsuite/text/test_string_casing_w3c_i18n.adb b/testsuite/text/test_transformer-test_casing_w3c_i18n.adb similarity index 75% rename from testsuite/text/test_string_casing_w3c_i18n.adb rename to testsuite/text/test_transformer-test_casing_w3c_i18n.adb index f8df7e0b..aa7e2b3e 100644 --- a/testsuite/text/test_string_casing_w3c_i18n.adb +++ b/testsuite/text/test_transformer-test_casing_w3c_i18n.adb @@ -1,17 +1,15 @@ -- --- Copyright (C) 2021, AdaCore +-- Copyright (C) 2021-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- -with Ada.Command_Line; with Ada.Wide_Wide_Text_IO; -with VSS.Strings; +with VSS.Transformers.Casing; -with Test_Support; - -procedure Test_String_Casing_W3C_I18N is +separate (Test_Transformer) +procedure Test_Casing_W3C_I18N is use type VSS.Strings.Virtual_String; File : Ada.Wide_Wide_Text_IO.File_Type; @@ -25,7 +23,7 @@ begin Ada.Wide_Wide_Text_IO.Open (File, Ada.Wide_Wide_Text_IO.In_File, - Ada.Command_Line.Argument (1), + VSS.Strings.Conversions.To_UTF_8_String (W3C_I18N_File), "wcem=8"); -- Skip name of the test @@ -61,9 +59,11 @@ begin Ada.Wide_Wide_Text_IO.Close (File); if Lowercase then - Test_Support.Assert (Source.To_Lowercase = Expected); + Test_Support.Assert + (VSS.Transformers.Casing.To_Lowercase.Transform (Source) = Expected); else - Test_Support.Assert (Source.To_Uppercase = Expected); + Test_Support.Assert + (VSS.Transformers.Casing.To_Uppercase.Transform (Source) = Expected); end if; -end Test_String_Casing_W3C_I18N; +end Test_Casing_W3C_I18N; diff --git a/testsuite/text/test_string_normalization.adb b/testsuite/text/test_transformer-test_ucd_normalizationtest.adb similarity index 64% rename from testsuite/text/test_string_normalization.adb rename to testsuite/text/test_transformer-test_ucd_normalizationtest.adb index f54a34fb..b42e754c 100644 --- a/testsuite/text/test_string_normalization.adb +++ b/testsuite/text/test_transformer-test_ucd_normalizationtest.adb @@ -1,20 +1,16 @@ -- --- Copyright (C) 2021, AdaCore +-- Copyright (C) 2021-2024, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- -with Ada.Command_Line; -with Ada.Strings.UTF_Encoding.Wide_Wide_Strings; - with VSS.Characters; -with VSS.Strings; +with VSS.Transformers.Normalization; with UCD.Data_File_Loaders; -with Test_Support; - -procedure Test_String_Normalization is +separate (Test_Transformer) +procedure Test_UCD_NormalizationTest is function Get_Field (Loader : UCD.Data_File_Loaders.File_Loader'Class; @@ -41,10 +37,6 @@ procedure Test_String_Normalization is end return; end Get_Field; - UCD_Root : constant Wide_Wide_String := - Ada.Strings.UTF_Encoding.Wide_Wide_Strings.Decode - (Ada.Command_Line.Argument (1)); - Loader : UCD.Data_File_Loaders.File_Loader; begin @@ -79,15 +71,20 @@ begin declare C1N : constant VSS.Strings.Virtual_String := - C1.To_Normalized (VSS.Strings.Normalization_Form_C); + VSS.Transformers.Normalization.To_Normalization_Form_C + .Transform (C1); C2N : constant VSS.Strings.Virtual_String := - C2.To_Normalized (VSS.Strings.Normalization_Form_C); + VSS.Transformers.Normalization.To_Normalization_Form_C + .Transform (C2); C3N : constant VSS.Strings.Virtual_String := - C3.To_Normalized (VSS.Strings.Normalization_Form_C); + VSS.Transformers.Normalization.To_Normalization_Form_C + .Transform (C3); C4N : constant VSS.Strings.Virtual_String := - C4.To_Normalized (VSS.Strings.Normalization_Form_C); + VSS.Transformers.Normalization.To_Normalization_Form_C + .Transform (C4); C5N : constant VSS.Strings.Virtual_String := - C5.To_Normalized (VSS.Strings.Normalization_Form_C); + VSS.Transformers.Normalization.To_Normalization_Form_C + .Transform (C4); begin Test_Support.Assert (C2 = C1N); @@ -101,15 +98,20 @@ begin declare C1N : constant VSS.Strings.Virtual_String := - C1.To_Normalized (VSS.Strings.Normalization_Form_D); + VSS.Transformers.Normalization.To_Normalization_Form_D + .Transform (C1); C2N : constant VSS.Strings.Virtual_String := - C2.To_Normalized (VSS.Strings.Normalization_Form_D); + VSS.Transformers.Normalization.To_Normalization_Form_D + .Transform (C2); C3N : constant VSS.Strings.Virtual_String := - C3.To_Normalized (VSS.Strings.Normalization_Form_D); + VSS.Transformers.Normalization.To_Normalization_Form_D + .Transform (C3); C4N : constant VSS.Strings.Virtual_String := - C4.To_Normalized (VSS.Strings.Normalization_Form_D); + VSS.Transformers.Normalization.To_Normalization_Form_D + .Transform (C4); C5N : constant VSS.Strings.Virtual_String := - C5.To_Normalized (VSS.Strings.Normalization_Form_D); + VSS.Transformers.Normalization.To_Normalization_Form_D + .Transform (C5); begin Test_Support.Assert (C3 = C1N); @@ -123,15 +125,20 @@ begin declare C1N : constant VSS.Strings.Virtual_String := - C1.To_Normalized (VSS.Strings.Normalization_Form_KC); + VSS.Transformers.Normalization.To_Normalization_Form_KC + .Transform (C1); C2N : constant VSS.Strings.Virtual_String := - C2.To_Normalized (VSS.Strings.Normalization_Form_KC); + VSS.Transformers.Normalization.To_Normalization_Form_KC + .Transform (C2); C3N : constant VSS.Strings.Virtual_String := - C3.To_Normalized (VSS.Strings.Normalization_Form_KC); + VSS.Transformers.Normalization.To_Normalization_Form_KC + .Transform (C3); C4N : constant VSS.Strings.Virtual_String := - C4.To_Normalized (VSS.Strings.Normalization_Form_KC); + VSS.Transformers.Normalization.To_Normalization_Form_KC + .Transform (C4); C5N : constant VSS.Strings.Virtual_String := - C5.To_Normalized (VSS.Strings.Normalization_Form_KC); + VSS.Transformers.Normalization.To_Normalization_Form_KC + .Transform (C5); begin Test_Support.Assert (C4 = C1N); @@ -145,15 +152,20 @@ begin declare C1N : constant VSS.Strings.Virtual_String := - C1.To_Normalized (VSS.Strings.Normalization_Form_KD); + VSS.Transformers.Normalization.To_Normalization_Form_KD + .Transform (C1); C2N : constant VSS.Strings.Virtual_String := - C2.To_Normalized (VSS.Strings.Normalization_Form_KD); + VSS.Transformers.Normalization.To_Normalization_Form_KD + .Transform (C2); C3N : constant VSS.Strings.Virtual_String := - C3.To_Normalized (VSS.Strings.Normalization_Form_KD); + VSS.Transformers.Normalization.To_Normalization_Form_KD + .Transform (C3); C4N : constant VSS.Strings.Virtual_String := - C4.To_Normalized (VSS.Strings.Normalization_Form_KD); + VSS.Transformers.Normalization.To_Normalization_Form_KD + .Transform (C4); C5N : constant VSS.Strings.Virtual_String := - C5.To_Normalized (VSS.Strings.Normalization_Form_KD); + VSS.Transformers.Normalization.To_Normalization_Form_KD + .Transform (C5); begin Test_Support.Assert (C5 = C1N); @@ -171,4 +183,4 @@ begin end loop; Loader.Close; -end Test_String_Normalization; +end Test_UCD_NormalizationTest; diff --git a/testsuite/text/test_transformer.adb b/testsuite/text/test_transformer.adb new file mode 100644 index 00000000..3f0f4faa --- /dev/null +++ b/testsuite/text/test_transformer.adb @@ -0,0 +1,91 @@ +-- +-- Copyright (C) 2023-2024, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +-- Test driver requires command line parameters: +-- 1) Path to UCD database +-- 2..*) Paths to W3C I18N test files + +with VSS.Application; +with VSS.Strings.Conversions; + +with Test_Support; + +procedure Test_Transformer is + + UCD_Root : constant Wide_Wide_String := + VSS.Strings.Conversions.To_Wide_Wide_String + (VSS.Application.Arguments.Element (1)); + + W3C_I18N_File : VSS.Strings.Virtual_String; + -- Path to test data file. Used by Test_Casing_W3C_I18N subprogram. + + -- Testsuites + + procedure Test_Normalization; + procedure Test_Casing; + + -- Testcases + + procedure Test_UCD_NormalizationTest; + procedure Test_Casing_Minimal; + procedure Test_Casing_W3C_I18N; + + ----------------- + -- Test_Casing -- + ----------------- + + procedure Test_Casing is + begin + Test_Support.Run_Testcase + (Test_Casing_Minimal'Access, + "Minimal case conversions"); + + for J in 2 .. VSS.Application.Arguments.Length loop + W3C_I18N_File := VSS.Application.Arguments.Element (J); + + Test_Support.Run_Testcase + (Test_Casing_Minimal'Access, + "W3C I18N case conversions (" + & VSS.Strings.Conversions.To_UTF_8_String (W3C_I18N_File) + & ")"); + end loop; + end Test_Casing; + + ------------------------- + -- Test_Casing_Minimal -- + ------------------------- + + procedure Test_Casing_Minimal is separate; + + -------------------------- + -- Test_Casing_W3C_I18N -- + -------------------------- + + procedure Test_Casing_W3C_I18N is separate; + + ------------------------ + -- Test_Normalization -- + ------------------------ + + procedure Test_Normalization is + begin + Test_Support.Run_Testcase + (Test_UCD_NormalizationTest'Access, + "UCD NormalizationTest.txt"); + end Test_Normalization; + + -------------------------------- + -- Test_UCD_NormalizationTest -- + -------------------------------- + + procedure Test_UCD_NormalizationTest is separate; + +begin + Test_Support.Run_Testsuite + (Test_Normalization'Access, "Normalization Transformation"); + Test_Support.Run_Testsuite + (Test_Casing'Access, "Case Conversion Transformation"); +end Test_Transformer;