diff --git a/Makefile b/Makefile index e1a26cac..4a1a54b2 100644 --- a/Makefile +++ b/Makefile @@ -92,6 +92,7 @@ check_text: .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; \ diff --git a/gnat/tests/vss_text_tests.gpr b/gnat/tests/vss_text_tests.gpr index 4bc5c06a..e8830980 100644 --- a/gnat/tests/vss_text_tests.gpr +++ b/gnat/tests/vss_text_tests.gpr @@ -39,6 +39,7 @@ project VSS_Text_Tests is "test_string_slice", "test_string_split", "test_string_split_lines", + "test_string_template", "test_string_vector", "test_word_iterators"); diff --git a/source/text/implementation/vss-implementation-character_codes.ads b/source/text/implementation/vss-implementation-character_codes.ads index 445a9e10..a79df8a1 100644 --- a/source/text/implementation/vss-implementation-character_codes.ads +++ b/source/text/implementation/vss-implementation-character_codes.ads @@ -22,7 +22,7 @@ package VSS.Implementation.Character_Codes is Space : constant := 16#00_0020#; -- ' ' Quotation_Mark : constant := 16#00_0022#; -- '"' - + Number_Sign : constant := 16#00_0023#; -- '#' Dollar_Sign : constant := 16#00_0024#; -- '$' Apostrophe : constant := 16#00_0027#; -- ''' diff --git a/source/text/implementation/vss-strings-formatters-generic_integers.adb b/source/text/implementation/vss-strings-formatters-generic_integers.adb index 9d432dff..9e77fe7d 100644 --- a/source/text/implementation/vss-strings-formatters-generic_integers.adb +++ b/source/text/implementation/vss-strings-formatters-generic_integers.adb @@ -4,8 +4,37 @@ -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- +with Interfaces; + +with VSS.Characters.Latin; +with VSS.Implementation.Character_Codes; +with VSS.Implementation.String_Handlers; +with VSS.Unicode; + package body VSS.Strings.Formatters.Generic_Integers is + type Sign_Options is + (Compact, + -- Don't preserve space for sign, but start negative values with + -- hyphen-minus. + Space_Or_Minus, + -- Preserve space for sign, fill it by whitespace for positive values. + Plus_Or_Minus); + -- Preserve space for sign, fill it by plus sign for positive values. + + type Formatter_Options is record + Sign : Sign_Options := Compact; + Width : VSS.Strings.Grapheme_Cluster_Count := 0; + Leading_Zeros : Boolean := False; + Base : Natural := 10; + Group : VSS.Strings.Grapheme_Cluster_Count := 0; + Separator : VSS.Characters.Virtual_Character := '_'; + end record; + + procedure Parse + (Format : VSS.Strings.Virtual_String; + Options : in out Formatter_Options); + ------------ -- Format -- ------------ @@ -15,18 +44,134 @@ package body VSS.Strings.Formatters.Generic_Integers is Format : VSS.Strings.Formatters.Format_Information) return VSS.Strings.Virtual_String is - Buffer : constant Wide_Wide_String := - Integer_Type'Wide_Wide_Image (Self.Value); + use VSS.Implementation.Character_Codes; + use type Interfaces.Unsigned_128; + use type VSS.Unicode.Code_Point_Unit; + + Buffer : Wide_Wide_String (1 .. Integer_Type'Size); + First : Positive := Buffer'Last + 1; + Options : Formatter_Options; + Negative : Boolean; + Value : Interfaces.Unsigned_128; + Result : VSS.Strings.Virtual_String; + Digit : VSS.Unicode.Code_Point_Unit; + Length : VSS.Strings.Grapheme_Cluster_Count; + + procedure Append_Sign; + + ----------------- + -- Append_Sign -- + ----------------- + + procedure Append_Sign is + begin + if Negative then + Result.Append (VSS.Characters.Latin.Hyphen_Minus); + + else + case Options.Sign is + when Compact => + null; + + when Space_Or_Minus => + Result.Append (VSS.Characters.Latin.Space); + + when Plus_Or_Minus => + Result.Append (VSS.Characters.Latin.Plus_Sign); + end case; + end if; + end Append_Sign; begin - if Buffer (Buffer'First) = ' ' then - return - VSS.Strings.To_Virtual_String - (Buffer (Buffer'First + 1 .. Buffer'Last)); + Parse (Format.Format, Options); + + -- Process sign + + if Self.Value < 0 then + declare + pragma Suppress (Overflow_Check); + + begin + Negative := True; + Value := Interfaces.Unsigned_128 (-Self.Value); + end; + + else + Negative := False; + Value := Interfaces.Unsigned_128 (Self.Value); + end if; + + -- Convert positive integer value into the text representation. + + if Value = 0 then + First := @ - 1; + Buffer (First) := Wide_Wide_Character'Val (Digit_Zero); + end if; + + while Value /= 0 loop + Digit := + VSS.Unicode.Code_Point_Unit + (Value mod Interfaces.Unsigned_128 (Options.Base)); + + if Digit in 0 .. 9 then + First := @ - 1; + Buffer (First) := Wide_Wide_Character'Val (Digit + Digit_Zero); + + elsif Digit in 10 .. 25 then + First := @ - 1; + Buffer (First) := + Wide_Wide_Character'Val (Digit - 10 + Latin_Capital_Letter_A); + + else + raise Program_Error; + end if; + + Value := Value / Interfaces.Unsigned_128 (Options.Base); + end loop; + + -- Fill leading zeros/spaces and sign. + + Length := VSS.Strings.Grapheme_Cluster_Count (Buffer'Last - First + 1); + + if Options.Width = 0 then + Append_Sign; + + elsif Options.Leading_Zeros then + Append_Sign; + + for J in reverse Length + 1 .. Options.Width loop + Result.Append (VSS.Characters.Latin.Digit_Zero); + + if Options.Group /= 0 + and then (J - 1) mod Options.Group = 0 + then + Result.Append (Options.Separator); + end if; + end loop; else - return VSS.Strings.To_Virtual_String (Buffer); + for J in reverse Length + 1 .. Options.Width loop + Result.Append (VSS.Characters.Latin.Space); + end loop; + + Append_Sign; end if; + + -- Append text representation. + + for J in First .. Buffer'Last loop + Result.Append (VSS.Characters.Virtual_Character (Buffer (J))); + + if Options.Group /= 0 + and then J /= Buffer'Last + and then VSS.Strings.Grapheme_Cluster_Count (Buffer'Last - J) + mod Options.Group = 0 + then + Result.Append (Options.Separator); + end if; + end loop; + + return Result; end Format; ----------- @@ -59,4 +204,137 @@ package body VSS.Strings.Formatters.Generic_Integers is return Self.Name; end Name; + ----------- + -- Parse -- + ----------- + + procedure Parse + (Format : VSS.Strings.Virtual_String; + Options : in out Formatter_Options) + is + use VSS.Implementation.Character_Codes; + use type VSS.Unicode.Code_Point_Unit; + + type States is + (Initial, Zero_Width_Base_Group, Width, Base, Group, Error); + + Handler : + constant VSS.Implementation.Strings.String_Handler_Access := + VSS.Implementation.Strings.Handler (Format.Data); + Position : VSS.Implementation.Strings.Cursor; + Code : VSS.Unicode.Code_Point'Base; + State : States := Initial; + + begin + Handler.Before_First_Character (Format.Data, Position); + + while Handler.Forward_Element (Format.Data, Position, Code) loop + case State is + when Initial => + case Code is + when Plus_Sign => + State := Zero_Width_Base_Group; + Options.Sign := Plus_Or_Minus; + + when Hyphen_Minus => + State := Zero_Width_Base_Group; + Options.Sign := Space_Or_Minus; + + when Digit_Zero => + State := Width; + Options.Leading_Zeros := True; + Options.Width := 0; + + when Digit_One .. Digit_Nine => + State := Width; + Options.Leading_Zeros := False; + Options.Width := + VSS.Strings.Grapheme_Cluster_Count (Code - Digit_Zero); + + when Number_Sign => + State := Base; + Options.Base := 0; + + when Low_Line => + State := Group; + + when others => + State := Error; + end case; + + when Zero_Width_Base_Group => + case Code is + when Digit_Zero => + State := Width; + Options.Leading_Zeros := True; + Options.Width := 0; + + when Digit_One .. Digit_Nine => + State := Width; + Options.Leading_Zeros := False; + Options.Width := + VSS.Strings.Grapheme_Cluster_Count (Code - Digit_Zero); + + when Number_Sign => + State := Base; + Options.Base := 0; + + when Low_Line => + State := Group; + + when others => + State := Error; + end case; + + when Width => + case Code is + when Digit_Zero .. Digit_Nine => + Options.Width := + @ * 10 + + VSS.Strings.Grapheme_Cluster_Count + (Code - Digit_Zero); + + when Number_Sign => + State := Base; + Options.Base := 0; + + when Low_Line => + State := Group; + + when others => + State := Error; + end case; + + when Base => + case Code is + when Digit_Zero .. Digit_Nine => + Options.Base := @ * 10 + Natural (Code - Digit_Zero); + + when Low_Line => + State := Group; + + when others => + State := Error; + end case; + + when Group => + case Code is + when Digit_Zero .. Digit_Nine => + Options.Group := + @ * 10 + + VSS.Strings.Grapheme_Cluster_Count + (Code - Digit_Zero); + + when others => + State := Error; + Options.Separator := + VSS.Characters.Virtual_Character'Val (Code); + end case; + + when Error => + exit; + end case; + end loop; + end Parse; + end VSS.Strings.Formatters.Generic_Integers; diff --git a/source/text/implementation/vss-strings-templates.adb b/source/text/implementation/vss-strings-templates.adb index 4615f52d..36182322 100644 --- a/source/text/implementation/vss-strings-templates.adb +++ b/source/text/implementation/vss-strings-templates.adb @@ -4,7 +4,7 @@ -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- -with VSS.Characters.Latin; +with VSS.Implementation.Character_Codes; with VSS.Implementation.String_Handlers; with VSS.Unicode; @@ -27,19 +27,23 @@ package body VSS.Strings.Templates is (Self : Virtual_String_Template'Class; Parameters : Formatter_Array) return VSS.Strings.Virtual_String is + use VSS.Implementation.Character_Codes; use type VSS.Unicode.Code_Point; - type States is (Initial, Open_Bracket, Format); + type States is (Initial, Open_Bracket, Name, Format); procedure Append_Parameter; - Handler : constant VSS.Implementation.Strings.String_Handler_Access := - VSS.Implementation.Strings.Handler (Self.Template.Data); - Position : VSS.Implementation.Strings.Cursor; - Code : VSS.Unicode.Code_Point'Base; - Parameter : Positive := 1; - State : States := Initial; - Result : VSS.Strings.Virtual_String; + Handler : + constant VSS.Implementation.Strings.String_Handler_Access := + VSS.Implementation.Strings.Handler (Self.Template.Data); + Position : VSS.Implementation.Strings.Cursor; + Code : VSS.Unicode.Code_Point'Base; + Parameter : Positive := 1; + State : States := Initial; + Result : VSS.Strings.Virtual_String; + Parameter_Format : VSS.Strings.Formatters.Format_Information; + -- Parameter_Format : VSS.Strings.Virtual_String; ---------------------- -- Append_Parameter -- @@ -48,10 +52,12 @@ package body VSS.Strings.Templates is procedure Append_Parameter is begin if Parameters (Parameter) /= null then - pragma Warnings (Off, "aggregate not fully initialized"); - Result.Append (Parameters (Parameter).Format ((others => <>))); - pragma Warnings (On, "aggregate not fully initialized"); + Result.Append (Parameters (Parameter).Format (Parameter_Format)); Parameter := @ + 1; + Parameter_Format := + (Width => 0, + Alignment => VSS.Strings.Formatters.Default, + Format => VSS.Strings.Empty_Virtual_String); end if; end Append_Parameter; @@ -61,43 +67,55 @@ package body VSS.Strings.Templates is while Handler.Forward_Element (Self.Template.Data, Position, Code) loop case State is when Initial => - if Code = - VSS.Characters.Virtual_Character'Pos - (VSS.Characters.Latin.Left_Curly_Bracket) - then - State := Open_Bracket; + case Code is + when Left_Curly_Bracket => + State := Open_Bracket; - else - Result.Append (VSS.Characters.Virtual_Character'Val (Code)); - end if; + when others => + Result.Append + (VSS.Characters.Virtual_Character'Val (Code)); + end case; when Open_Bracket => - if Code = - VSS.Characters.Virtual_Character'Pos - (VSS.Characters.Latin.Left_Curly_Bracket) - then - Result.Append ('{'); - State := Initial; - - elsif Code = - VSS.Characters.Virtual_Character'Pos - (VSS.Characters.Latin.Right_Curly_Bracket) - then - Append_Parameter; - State := Initial; - - else - State := Format; - end if; + case Code is + when Left_Curly_Bracket => + Result.Append ('{'); + State := Initial; + + when Right_Curly_Bracket => + Append_Parameter; + State := Initial; + + when Colon => + State := Format; + + when others => + State := Name; + end case; + + when Name => + case Code is + when Right_Curly_Bracket => + Append_Parameter; + State := Initial; + + when Colon => + State := Format; + + when others => + null; + end case; when Format => - if Code = - VSS.Characters.Virtual_Character'Pos - (VSS.Characters.Latin.Right_Curly_Bracket) - then - Append_Parameter; - State := Initial; - end if; + case Code is + when Right_Curly_Bracket => + Append_Parameter; + State := Initial; + + when others => + Parameter_Format.Format.Append + (VSS.Characters.Virtual_Character'Val (Code)); + end case; end case; end loop; diff --git a/source/text/vss-strings-formatters-generic_integers.ads b/source/text/vss-strings-formatters-generic_integers.ads index faa3f6be..932fea6e 100644 --- a/source/text/vss-strings-formatters-generic_integers.ads +++ b/source/text/vss-strings-formatters-generic_integers.ads @@ -7,7 +7,7 @@ -- This package provides formatter for integer types. -- -- Integer_Formatter supports following formatting options: --- [+-][0][1-9[0-9]*][#[1-9][0-9]+] +-- [+-][0][1-9[0-9]*][#[1-9][0-9]+][_[1-9][0-9]+[_,. ]] -- -- + - reserve space for sign, put plus sign for positive values and minus -- sign for negative values @@ -27,6 +27,13 @@ -- #[1-9][0-9]* - base -- -- By default, base is 10. +-- +-- _[1-9][0-9]+[^}] - groups separation +-- +-- Number of digits in group and character to be used as group separator. +-- +-- By default, group separation is disabled; default group separator is +-- low line character. generic type Integer_Type is range <>; diff --git a/testsuite/text/test_string_template.adb b/testsuite/text/test_string_template.adb new file mode 100644 index 00000000..271dfb2f --- /dev/null +++ b/testsuite/text/test_string_template.adb @@ -0,0 +1,211 @@ +-- +-- Copyright (C) 2023, AdaCore +-- +-- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +-- + +with Interfaces; + +with VSS.Strings.Formatters.Generic_Integers; +with VSS.Strings.Formatters.Strings; +with VSS.Strings.Templates; + +with Test_Support; + +procedure Test_String_Template is + + procedure Test_Single_Placeholer; + + procedure Test_Multiple_Placeholer; + + procedure Test_Integer_Formatter; + + ---------------------------- + -- Test_Integer_Formatter -- + ---------------------------- + + procedure Test_Integer_Formatter is + + use type VSS.Strings.Virtual_String; + + package Integer_Formatters is + new VSS.Strings.Formatters.Generic_Integers (Interfaces.Integer_128); + + begin + -- Smallest negative value. + + declare + Value : constant Interfaces.Integer_128 := + Interfaces.Integer_128'First; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + Image : constant VSS.Strings.Virtual_String := + VSS.Strings.To_Virtual_String + (Interfaces.Integer_128'Wide_Wide_Image (Value)); + + begin + Test_Support.Assert (Text = Image); + end; + + -- Largest positive value. + + declare + Value : constant Interfaces.Integer_128 := + Interfaces.Integer_128'Last; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + " {}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + Image : constant VSS.Strings.Virtual_String := + VSS.Strings.To_Virtual_String + (Interfaces.Integer_128'Wide_Wide_Image (Value)); + + begin + Test_Support.Assert (Text = Image); + end; + + -- Zero value. + + declare + Value : constant Interfaces.Integer_128 := 0; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + " {}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + Image : constant VSS.Strings.Virtual_String := + VSS.Strings.To_Virtual_String + (Interfaces.Integer_128'Wide_Wide_Image (Value)); + + begin + Test_Support.Assert (Text = Image); + end; + + -- Fixed width, without zero padding, positive value + + declare + Value : constant Interfaces.Integer_128 := 12345; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{:+10}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + + begin + Test_Support.Assert (Text = " +12345"); + end; + + -- Fixed width, with zero padding, positive value + + declare + Value : constant Interfaces.Integer_128 := 12345; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{:+010}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + + begin + Test_Support.Assert (Text = "+0000012345"); + end; + + -- Fixed width, width overflow, positive value, sign padding + + declare + -- use type Interfaces.Integer_128; + + Value : constant Interfaces.Integer_128 := 1234567890; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{:-8}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + + begin + Test_Support.Assert (Text = " 1234567890"); + end; + + -- Base, fixed width, grouping + + declare + Value : constant Interfaces.Integer_128 := 16#ABCD_1234#; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{:8#16_4}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + + begin + Test_Support.Assert (Text = "ABCD_1234"); + end; + + -- Base, fixed width, padding, grouping + + declare + Value : constant Interfaces.Integer_128 := 16#EF#; + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{:08#16_4}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (Integer_Formatters.Image (Value)); + + begin + Test_Support.Assert (Text = "0000_00EF"); + end; + end Test_Integer_Formatter; + + ------------------------------ + -- Test_Multiple_Placeholer -- + ------------------------------ + + procedure Test_Multiple_Placeholer is + + use type VSS.Strings.Virtual_String; + + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{}:{}:{}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format + (VSS.Strings.Formatters.Strings.Image ("a"), + VSS.Strings.Formatters.Strings.Image ("b"), + VSS.Strings.Formatters.Strings.Image ("c")); + + begin + Test_Support.Assert (Text = "a:b:c"); + end Test_Multiple_Placeholer; + + ---------------------------- + -- Test_Single_Placeholer -- + ---------------------------- + + procedure Test_Single_Placeholer is + + use type VSS.Strings.Virtual_String; + + begin + -- Placeholder only + + declare + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "{}"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (VSS.Strings.Formatters.Strings.Image ("world")); + + begin + Test_Support.Assert (Text = "world"); + end; + + -- Placeholder inside the text + + declare + Template : constant VSS.Strings.Templates.Virtual_String_Template := + "Hello, {}!"; + Text : constant VSS.Strings.Virtual_String := + Template.Format (VSS.Strings.Formatters.Strings.Image ("world")); + + begin + Test_Support.Assert (Text = "Hello, world!"); + end; + end Test_Single_Placeholer; + +begin + Test_Single_Placeholer; + Test_Multiple_Placeholer; + Test_Integer_Formatter; +end Test_String_Template;