This patch updates the routines which produce Wide_String and Wide_Wide_String
from a String to construct a result of the proper maximum size which is later
sliced.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-07-16 Hristian Kirtchev <kirtc...@adacore.com>
gcc/ada/
* libgnat/s-wchwts.adb (Wide_String_To_String): Use the appropriate
longest sequence factor. Code clean up.
(Wide_Wide_String_To_String): Use the appropriate longest sequence
factor. Code clean up.
gcc/testsuite/
* gnat.dg/wide_wide_value1.adb: New testcase.--- gcc/ada/libgnat/s-wchwts.adb
+++ gcc/ada/libgnat/s-wchwts.adb
@@ -86,16 +86,23 @@ package body System.WCh_WtS is
(S : Wide_String;
EM : WC_Encoding_Method) return String
is
- R : String (S'First .. S'First + 5 * S'Length); -- worst case length
- RP : Natural;
+ Max_Chars : constant Natural := WC_Longest_Sequences (EM);
+
+ Result : String (S'First .. S'First + Max_Chars * S'Length);
+ Result_Idx : Natural;
begin
- RP := R'First - 1;
- for SP in S'Range loop
- Store_UTF_32_Character (Wide_Character'Pos (S (SP)), R, RP, EM);
+ Result_Idx := Result'First - 1;
+
+ for S_Idx in S'Range loop
+ Store_UTF_32_Character
+ (U => Wide_Character'Pos (S (S_Idx)),
+ S => Result,
+ P => Result_Idx,
+ EM => EM);
end loop;
- return R (R'First .. RP);
+ return Result (Result'First .. Result_Idx);
end Wide_String_To_String;
--------------------------------
@@ -106,17 +113,23 @@ package body System.WCh_WtS is
(S : Wide_Wide_String;
EM : WC_Encoding_Method) return String
is
- R : String (S'First .. S'First + 7 * S'Length); -- worst case length
- RP : Natural;
+ Max_Chars : constant Natural := WC_Longest_Sequences (EM);
- begin
- RP := R'First - 1;
+ Result : String (S'First .. S'First + Max_Chars * S'Length);
+ Result_Idx : Natural;
- for SP in S'Range loop
- Store_UTF_32_Character (Wide_Wide_Character'Pos (S (SP)), R, RP, EM);
+ begin
+ Result_Idx := Result'First - 1;
+
+ for S_Idx in S'Range loop
+ Store_UTF_32_Character
+ (U => Wide_Wide_Character'Pos (S (S_Idx)),
+ S => Result,
+ P => Result_Idx,
+ EM => EM);
end loop;
- return R (R'First .. RP);
+ return Result (Result'First .. Result_Idx);
end Wide_Wide_String_To_String;
end System.WCh_WtS;
--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/wide_wide_value1.adb
@@ -0,0 +1,60 @@
+-- { dg-do run }
+
+with Ada.Text_IO; use Ada.Text_IO;
+
+procedure Wide_Wide_Value1 is
+begin
+ begin
+ declare
+ Str : constant Wide_Wide_String :=
+ Wide_Wide_Character'Val (16#00000411#) &
+ Wide_Wide_Character'Val (16#0000043e#) &
+ Wide_Wide_Character'Val (16#00000434#) &
+ Wide_Wide_Character'Val (16#00000430#) &
+ Wide_Wide_Character'Val (16#00000443#) &
+ Wide_Wide_Character'Val (16#00000431#) &
+ Wide_Wide_Character'Val (16#00000430#) &
+ Wide_Wide_Character'Val (16#00000435#) &
+ Wide_Wide_Character'Val (16#00000432#) &
+ Wide_Wide_Character'Val (16#00000416#) &
+ Wide_Wide_Character'Val (16#00000443#) &
+ Wide_Wide_Character'Val (16#0000043c#) &
+ Wide_Wide_Character'Val (16#00000430#) &
+ Wide_Wide_Character'Val (16#00000442#) &
+ Wide_Wide_Character'Val (16#0000041c#) &
+ Wide_Wide_Character'Val (16#00000430#) &
+ Wide_Wide_Character'Val (16#00000440#) &
+ Wide_Wide_Character'Val (16#00000430#) &
+ Wide_Wide_Character'Val (16#00000442#) &
+ Wide_Wide_Character'Val (16#0000043e#) &
+ Wide_Wide_Character'Val (16#00000432#) &
+ Wide_Wide_Character'Val (16#00000438#) &
+ Wide_Wide_Character'Val (16#00000447#);
+
+ Val : constant Integer := Integer'Wide_Wide_Value (Str);
+ begin
+ Put_Line ("ERROR: 1: Constraint_Error not raised");
+ end;
+ exception
+ when Constraint_Error =>
+ null;
+ when others =>
+ Put_Line ("ERROR: 1: unexpected exception");
+ end;
+
+ begin
+ declare
+ Str : Wide_Wide_String (1 .. 128) :=
+ (others => Wide_Wide_Character'Val (16#0FFFFFFF#));
+
+ Val : constant Integer := Integer'Wide_Wide_Value (Str);
+ begin
+ Put_Line ("ERROR: 1: Constraint_Error not raised");
+ end;
+ exception
+ when Constraint_Error =>
+ null;
+ when others =>
+ Put_Line ("ERROR: 1: unexpected exception");
+ end;
+end Wide_Wide_Value1;
