-- -- Copyright (C) 2020-2023, AdaCore -- -- SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception -- with Ada.Strings.Unbounded; with Ada.Strings.UTF_Encoding; with Ada.Strings.Wide_Wide_Unbounded; with VSS.Strings.Conversions; with Hello_World_Data; with Test_Support; procedure Test_String_Conversions is procedure Do_Test (UTF_32_Encoded : Wide_Wide_String; UTF_8_Encoded : Ada.Strings.UTF_Encoding.UTF_8_String); -- Do test for given string ------------- -- Do_Test -- ------------- procedure Do_Test (UTF_32_Encoded : Wide_Wide_String; UTF_8_Encoded : Ada.Strings.UTF_Encoding.UTF_8_String) is use type Ada.Strings.Unbounded.Unbounded_String; use type Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String; begin -- Virtual_String created from UTF-32 encoded Wide_Wide_String declare S : constant VSS.Strings.Virtual_String := VSS.Strings.To_Virtual_String (UTF_32_Encoded); begin Test_Support.Assert (VSS.Strings.Conversions.To_UTF_8_String (S) = UTF_8_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_UTF_8_String (S) = Ada.Strings.Unbounded.To_Unbounded_String (UTF_8_Encoded)); Test_Support.Assert (VSS.Strings.Conversions.To_Wide_Wide_String (S) = UTF_32_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (S) = Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String (UTF_32_Encoded)); end; -- Virtual_String created from UTF-32 encoded Unbounded_Wide_Wide_String declare S : constant VSS.Strings.Virtual_String := VSS.Strings.Conversions.To_Virtual_String (Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String (UTF_32_Encoded)); begin Test_Support.Assert (VSS.Strings.Conversions.To_UTF_8_String (S) = UTF_8_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_UTF_8_String (S) = Ada.Strings.Unbounded.To_Unbounded_String (UTF_8_Encoded)); Test_Support.Assert (VSS.Strings.Conversions.To_Wide_Wide_String (S) = UTF_32_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (S) = Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String (UTF_32_Encoded)); end; -- Virtual_String created from UTF-8 encoded String declare S : constant VSS.Strings.Virtual_String := VSS.Strings.Conversions.To_Virtual_String (UTF_8_Encoded); begin Test_Support.Assert (VSS.Strings.Conversions.To_UTF_8_String (S) = UTF_8_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_UTF_8_String (S) = Ada.Strings.Unbounded.To_Unbounded_String (UTF_8_Encoded)); Test_Support.Assert (VSS.Strings.Conversions.To_Wide_Wide_String (S) = UTF_32_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (S) = Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String (UTF_32_Encoded)); end; -- Virtual_String created from UTF-8 encoded Unbounded_String declare S : constant VSS.Strings.Virtual_String := VSS.Strings.Conversions.To_Virtual_String (Ada.Strings.Unbounded.To_Unbounded_String (UTF_8_Encoded)); begin Test_Support.Assert (VSS.Strings.Conversions.To_UTF_8_String (S) = UTF_8_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_UTF_8_String (S) = Ada.Strings.Unbounded.To_Unbounded_String (UTF_8_Encoded)); Test_Support.Assert (VSS.Strings.Conversions.To_Wide_Wide_String (S) = UTF_32_Encoded); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (S) = Ada.Strings.Wide_Wide_Unbounded.To_Unbounded_Wide_Wide_String (UTF_32_Encoded)); end; -- Test Set_* family of subprograms, which fills exact string declare S : constant VSS.Strings.Virtual_String := VSS.Strings.To_Virtual_String (UTF_32_Encoded); BS : String (1 .. UTF_8_Encoded'Length); BW : Wide_Wide_String (1 .. UTF_32_Encoded'Length); begin VSS.Strings.Conversions.Set_UTF_8_String (S, BS); Test_Support.Assert (BS = UTF_8_Encoded); VSS.Strings.Conversions.Set_Wide_Wide_String (S, BW); Test_Support.Assert (BW = UTF_32_Encoded); end; -- Test Set_* family of subprograms, which fills string buffer declare S : constant VSS.Strings.Virtual_String := VSS.Strings.To_Virtual_String (UTF_32_Encoded); BS : String (1 .. UTF_8_Encoded'Length + 10); BW : Wide_Wide_String (1 .. UTF_32_Encoded'Length + 10); L : Natural; begin VSS.Strings.Conversions.Set_UTF_8_String (S, L, BS); Test_Support.Assert (BS (BS'First .. L) = UTF_8_Encoded); VSS.Strings.Conversions.Set_Wide_Wide_String (S, L, BW); Test_Support.Assert (BW (BW'First .. L) = UTF_32_Encoded); end; end Do_Test; begin -- Check conversion of "Hello, world!" in different languages. It is known -- all strings are well-formed, there should be no exceptions. Note, it is -- sanity check, it doesn't cover all cases of UTF-8 validation. for Language in Hello_World_Data.Language'Range loop declare String : VSS.Strings.Virtual_String; begin String := VSS.Strings.Conversions.To_Virtual_String (Hello_World_Data.Hello (Language)); if VSS.Strings.Conversions.To_UTF_8_String (String) /= Hello_World_Data.Hello (Language) then raise Program_Error; end if; -- Check conversion to Wide_Wide_String, it may be improved by -- providing Wide_Wide_String version in Hello_World_Data. if VSS.Strings.Conversions.To_Wide_Wide_String (String) /= VSS.Strings.Conversions.To_Wide_Wide_String (VSS.Strings.To_Virtual_String (VSS.Strings.Conversions.To_Wide_Wide_String (String))) then raise Program_Error; end if; -- Check conversion to Wide_Wide_String, it may be improved by -- providing Wide_Wide_String version in Hello_World_Data. if VSS.Strings.Conversions.To_Wide_Wide_String (String) /= VSS.Strings.Conversions.To_Wide_Wide_String (VSS.Strings.To_Virtual_String (Ada.Strings.Wide_Wide_Unbounded.To_Wide_Wide_String (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (String)))) then raise Program_Error; end if; end; end loop; -- Check conversion of one character of each representation length in -- UTF-8. First string is quite short and may fit to be stored in-place -- while second one is large enought to be stored by handler with -- allocation. -- -- More cases may need to be added to cover other configurations of string -- handlers. declare S1 : constant Wide_Wide_String := "Aะ‘เค•๐Œˆ"; S2 : constant Wide_Wide_String := "Aะ‘เค•๐Œˆ๐Œˆเค•ะ‘A"; E1 : constant Ada.Strings.UTF_Encoding.UTF_8_String := [1 => Character'Val (16#41#), 2 => Character'Val (16#D0#), 3 => Character'Val (16#91#), 4 => Character'Val (16#E0#), 5 => Character'Val (16#A4#), 6 => Character'Val (16#95#), 7 => Character'Val (16#F0#), 8 => Character'Val (16#90#), 9 => Character'Val (16#8C#), 10 => Character'Val (16#88#)]; E2 : constant Ada.Strings.UTF_Encoding.UTF_8_String := [1 => Character'Val (16#41#), 2 => Character'Val (16#D0#), 3 => Character'Val (16#91#), 4 => Character'Val (16#E0#), 5 => Character'Val (16#A4#), 6 => Character'Val (16#95#), 7 => Character'Val (16#F0#), 8 => Character'Val (16#90#), 9 => Character'Val (16#8C#), 10 => Character'Val (16#88#), 11 => Character'Val (16#F0#), 12 => Character'Val (16#90#), 13 => Character'Val (16#8C#), 14 => Character'Val (16#88#), 15 => Character'Val (16#E0#), 16 => Character'Val (16#A4#), 17 => Character'Val (16#95#), 18 => Character'Val (16#D0#), 19 => Character'Val (16#91#), 20 => Character'Val (16#41#)]; begin Do_Test (S1, E1); Do_Test (S2, E2); end; -- Check that null string is handled properly. declare N : VSS.Strings.Virtual_String; pragma Warnings (Off, N); begin if VSS.Strings.Conversions.To_UTF_8_String (N) /= "" then raise Program_Error; end if; end; -- T717-008 Check that conversion of quite large Wide_Wide_String is -- successful. declare S : constant Wide_Wide_String := "This is large string literal to test conversion from " & " Wide_Wide_String to Virtual_String. At the time of initial " & "development this string literal requires to have at least " & "256 (two hundreds fithty six) characters to overflow unsigned " & "8 (eight) bit wide Length member of the UTF-8 ib place string " & "handler."; E : constant Ada.Strings.UTF_Encoding.UTF_8_String := "This is large string literal to test conversion from " & " Wide_Wide_String to Virtual_String. At the time of initial " & "development this string literal requires to have at least " & "256 (two hundreds fithty six) characters to overflow unsigned " & "8 (eight) bit wide Length member of the UTF-8 ib place string " & "handler."; begin Do_Test (S, E); end; -- Check conversion of the null and empty strings to -- Unbounded_String/Unbounded_Wide_Wide_String. declare use type Ada.Strings.Unbounded.Unbounded_String; use type Ada.Strings.Wide_Wide_Unbounded.Unbounded_Wide_Wide_String; Null_Virtual_String : constant VSS.Strings.Virtual_String := VSS.Strings.Empty_Virtual_String; -- VSS.Strings.Empty_Virtual_String is null string by convention. Empty_Virtual_String : constant VSS.Strings.Virtual_String := ""; begin Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_UTF_8_String (Null_Virtual_String) = Ada.Strings.Unbounded.Null_Unbounded_String); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_UTF_8_String (Empty_Virtual_String) = Ada.Strings.Unbounded.Null_Unbounded_String); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (Null_Virtual_String) = Ada.Strings.Wide_Wide_Unbounded.Null_Unbounded_Wide_Wide_String); Test_Support.Assert (VSS.Strings.Conversions.To_Unbounded_Wide_Wide_String (Empty_Virtual_String) = Ada.Strings.Wide_Wide_Unbounded.Null_Unbounded_Wide_Wide_String); end; end Test_String_Conversions;