From ce80a8930b353ce2699c07cf687cf902121195e3 Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 8 Sep 2023 14:03:54 +0400 Subject: [PATCH 1/5] Implement formatting specifiers for integer formatters. --- .../vss-implementation-character_codes.ads | 2 +- ...ss-strings-formatters-generic_integers.adb | 220 +++++++++++++++++- .../implementation/vss-strings-templates.adb | 106 +++++---- 3 files changed, 276 insertions(+), 52 deletions(-) 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..3f373274 100644 --- a/source/text/implementation/vss-strings-formatters-generic_integers.adb +++ b/source/text/implementation/vss-strings-formatters-generic_integers.adb @@ -4,8 +4,35 @@ -- 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; + end record; + + procedure Parse + (Format : VSS.Strings.Virtual_String; + Options : in out Formatter_Options); + ------------ -- Format -- ------------ @@ -15,18 +42,91 @@ 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.Integer_128; + use type VSS.Unicode.Code_Point_Unit; + + Buffer : Wide_Wide_String (1 .. Integer_Type'Size); + First : Positive := Buffer'Last + 1; + Options : Formatter_Options; + Value : Interfaces.Integer_128 := Interfaces.Integer_128 (Self.Value); + Result : VSS.Strings.Virtual_String; + Digit : VSS.Unicode.Code_Point_Unit; + Length : VSS.Strings.Grapheme_Cluster_Count; 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 Value < 0 then + Value := -Value; + Result.Append ('-'); else - return VSS.Strings.To_Virtual_String (Buffer); + case Options.Sign is + when Compact => + null; + + when Space_Or_Minus => + Result.Append (' '); + + when Plus_Or_Minus => + Result.Append ('+'); + end case; + 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.Integer_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.Integer_128 (Options.Base); + end loop; + + -- Fill leading zeros/spaces. + + if Options.Width /= 0 then + Length := + VSS.Strings.Grapheme_Cluster_Count (Buffer'Last - First + 1); + + for J in 1 .. Options.Width - Length loop + if Options.Leading_Zeros then + Result.Append (VSS.Characters.Latin.Digit_Zero); + + else + Result.Append (VSS.Characters.Latin.Space); + end if; + end loop; + end if; + + -- Append text representation. + + for J in First .. Buffer'Last loop + Result.Append (VSS.Characters.Virtual_Character (Buffer (J))); + end loop; + + return Result; end Format; ----------- @@ -59,4 +159,110 @@ 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, Width, Base, 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; + Options.Sign := Plus_Or_Minus; + + when Hyphen_Minus => + State := Zero_Width_Base; + 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 others => + State := Error; + end case; + + when Zero_Width_Base => + 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 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 others => + State := Error; + end case; + + when Base => + case Code is + when Digit_Zero .. Digit_Nine => + Options.Base := @ * 10 + Natural (Code - Digit_Zero); + + when others => + State := Error; + 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; From 61b21e835ed46e4d8ec3787f355148a18cf3f53c Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 8 Sep 2023 15:12:57 +0400 Subject: [PATCH 2/5] Add support of group separation to integer formatter. --- ...ss-strings-formatters-generic_integers.adb | 53 +++++++++++++++++-- ...ss-strings-formatters-generic_integers.ads | 9 +++- 2 files changed, 56 insertions(+), 6 deletions(-) diff --git a/source/text/implementation/vss-strings-formatters-generic_integers.adb b/source/text/implementation/vss-strings-formatters-generic_integers.adb index 3f373274..44c5791c 100644 --- a/source/text/implementation/vss-strings-formatters-generic_integers.adb +++ b/source/text/implementation/vss-strings-formatters-generic_integers.adb @@ -27,6 +27,8 @@ package body VSS.Strings.Formatters.Generic_Integers is 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 @@ -110,10 +112,16 @@ package body VSS.Strings.Formatters.Generic_Integers is Length := VSS.Strings.Grapheme_Cluster_Count (Buffer'Last - First + 1); - for J in 1 .. Options.Width - Length loop + for J in reverse Length + 1 .. Options.Width loop if Options.Leading_Zeros then 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; + else Result.Append (VSS.Characters.Latin.Space); end if; @@ -124,6 +132,14 @@ package body VSS.Strings.Formatters.Generic_Integers is 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; @@ -170,7 +186,8 @@ package body VSS.Strings.Formatters.Generic_Integers is use VSS.Implementation.Character_Codes; use type VSS.Unicode.Code_Point_Unit; - type States is (Initial, Zero_Width_Base, Width, Base, Error); + type States is + (Initial, Zero_Width_Base_Group, Width, Base, Group, Error); Handler : constant VSS.Implementation.Strings.String_Handler_Access := @@ -187,11 +204,11 @@ package body VSS.Strings.Formatters.Generic_Integers is when Initial => case Code is when Plus_Sign => - State := Zero_Width_Base; + State := Zero_Width_Base_Group; Options.Sign := Plus_Or_Minus; when Hyphen_Minus => - State := Zero_Width_Base; + State := Zero_Width_Base_Group; Options.Sign := Space_Or_Minus; when Digit_Zero => @@ -209,11 +226,14 @@ package body VSS.Strings.Formatters.Generic_Integers is State := Base; Options.Base := 0; + when Low_Line => + State := Group; + when others => State := Error; end case; - when Zero_Width_Base => + when Zero_Width_Base_Group => case Code is when Digit_Zero => State := Width; @@ -230,6 +250,9 @@ package body VSS.Strings.Formatters.Generic_Integers is State := Base; Options.Base := 0; + when Low_Line => + State := Group; + when others => State := Error; end case; @@ -246,6 +269,9 @@ package body VSS.Strings.Formatters.Generic_Integers is State := Base; Options.Base := 0; + when Low_Line => + State := Group; + when others => State := Error; end case; @@ -255,10 +281,27 @@ package body VSS.Strings.Formatters.Generic_Integers 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; 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 <>; From 876bc542177318626a336642c1fe4fe4b35b2b98 Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 8 Sep 2023 15:52:32 +0400 Subject: [PATCH 3/5] Use modular type and suppress overflow check... ... when smallest negative value is converted to positive value. --- ...ss-strings-formatters-generic_integers.adb | 20 +++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/source/text/implementation/vss-strings-formatters-generic_integers.adb b/source/text/implementation/vss-strings-formatters-generic_integers.adb index 44c5791c..a8143d34 100644 --- a/source/text/implementation/vss-strings-formatters-generic_integers.adb +++ b/source/text/implementation/vss-strings-formatters-generic_integers.adb @@ -45,13 +45,13 @@ package body VSS.Strings.Formatters.Generic_Integers is return VSS.Strings.Virtual_String is use VSS.Implementation.Character_Codes; - use type Interfaces.Integer_128; + 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; - Value : Interfaces.Integer_128 := Interfaces.Integer_128 (Self.Value); + Value : Interfaces.Unsigned_128; Result : VSS.Strings.Virtual_String; Digit : VSS.Unicode.Code_Point_Unit; Length : VSS.Strings.Grapheme_Cluster_Count; @@ -61,11 +61,19 @@ package body VSS.Strings.Formatters.Generic_Integers is -- Process sign - if Value < 0 then - Value := -Value; + if Self.Value < 0 then + declare + pragma Suppress (Overflow_Check); + + begin + Value := Interfaces.Unsigned_128 (-Self.Value); + end; + Result.Append ('-'); else + Value := Interfaces.Unsigned_128 (Self.Value); + case Options.Sign is when Compact => null; @@ -88,7 +96,7 @@ package body VSS.Strings.Formatters.Generic_Integers is while Value /= 0 loop Digit := VSS.Unicode.Code_Point_Unit - (Value mod Interfaces.Integer_128 (Options.Base)); + (Value mod Interfaces.Unsigned_128 (Options.Base)); if Digit in 0 .. 9 then First := @ - 1; @@ -103,7 +111,7 @@ package body VSS.Strings.Formatters.Generic_Integers is raise Program_Error; end if; - Value := Value / Interfaces.Integer_128 (Options.Base); + Value := Value / Interfaces.Unsigned_128 (Options.Base); end loop; -- Fill leading zeros/spaces. From 8c78eb7a3f04ff4e2ebbabeda1d25fca6d467678 Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 8 Sep 2023 16:22:15 +0400 Subject: [PATCH 4/5] Properly put sign on padding by spaces. --- ...ss-strings-formatters-generic_integers.adb | 93 ++++++++++++------- 1 file changed, 57 insertions(+), 36 deletions(-) diff --git a/source/text/implementation/vss-strings-formatters-generic_integers.adb b/source/text/implementation/vss-strings-formatters-generic_integers.adb index a8143d34..9e77fe7d 100644 --- a/source/text/implementation/vss-strings-formatters-generic_integers.adb +++ b/source/text/implementation/vss-strings-formatters-generic_integers.adb @@ -48,13 +48,39 @@ package body VSS.Strings.Formatters.Generic_Integers is 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; - Value : Interfaces.Unsigned_128; - Result : VSS.Strings.Virtual_String; - Digit : VSS.Unicode.Code_Point_Unit; - Length : VSS.Strings.Grapheme_Cluster_Count; + 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 Parse (Format.Format, Options); @@ -66,24 +92,13 @@ package body VSS.Strings.Formatters.Generic_Integers is pragma Suppress (Overflow_Check); begin - Value := Interfaces.Unsigned_128 (-Self.Value); + Negative := True; + Value := Interfaces.Unsigned_128 (-Self.Value); end; - Result.Append ('-'); - else - Value := Interfaces.Unsigned_128 (Self.Value); - - case Options.Sign is - when Compact => - null; - - when Space_Or_Minus => - Result.Append (' '); - - when Plus_Or_Minus => - Result.Append ('+'); - end case; + Negative := False; + Value := Interfaces.Unsigned_128 (Self.Value); end if; -- Convert positive integer value into the text representation. @@ -114,26 +129,32 @@ package body VSS.Strings.Formatters.Generic_Integers is Value := Value / Interfaces.Unsigned_128 (Options.Base); end loop; - -- Fill leading zeros/spaces. + -- Fill leading zeros/spaces and sign. - if Options.Width /= 0 then - Length := - VSS.Strings.Grapheme_Cluster_Count (Buffer'Last - First + 1); + Length := VSS.Strings.Grapheme_Cluster_Count (Buffer'Last - First + 1); - for J in reverse Length + 1 .. Options.Width loop - if Options.Leading_Zeros then - Result.Append (VSS.Characters.Latin.Digit_Zero); + if Options.Width = 0 then + Append_Sign; - if Options.Group /= 0 - and then (J - 1) mod Options.Group = 0 - then - Result.Append (Options.Separator); - end if; + elsif Options.Leading_Zeros then + Append_Sign; - else - Result.Append (VSS.Characters.Latin.Space); + 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 + for J in reverse Length + 1 .. Options.Width loop + Result.Append (VSS.Characters.Latin.Space); + end loop; + + Append_Sign; end if; -- Append text representation. From a16ea63bab055ea4a6395ef9d4790cbc953fe9bd Mon Sep 17 00:00:00 2001 From: Vadim Godunko Date: Fri, 8 Sep 2023 16:23:52 +0400 Subject: [PATCH 5/5] Automated test for string templates. --- Makefile | 1 + gnat/tests/vss_text_tests.gpr | 1 + testsuite/text/test_string_template.adb | 211 ++++++++++++++++++++++++ 3 files changed, 213 insertions(+) create mode 100644 testsuite/text/test_string_template.adb 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/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;