From 3c820aca5548d850811e41f7aa85f4a7fb10d6ed Mon Sep 17 00:00:00 2001 From: Hristian Kirtchev Date: Mon, 16 Jul 2018 14:10:58 +0000 Subject: [PATCH] [Ada] Segmentation_Fault with Integer'Wide_Wide_Value 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. 2018-07-16 Hristian Kirtchev 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. From-SVN: r262713 --- gcc/ada/ChangeLog | 7 +++ gcc/ada/libgnat/s-wchwts.adb | 39 +++++++++----- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/wide_wide_value1.adb | 60 ++++++++++++++++++++++ 4 files changed, 97 insertions(+), 13 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/wide_wide_value1.adb diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 51b73f8bf23..a782582543e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2018-07-16 Hristian Kirtchev + + * 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. + 2018-07-16 Javier Miranda * sem_ch13.adb (Analyze_Attribute_Definition_Clause): Report an error diff --git a/gcc/ada/libgnat/s-wchwts.adb b/gcc/ada/libgnat/s-wchwts.adb index c5556abba68..4eed382bbb8 100644 --- a/gcc/ada/libgnat/s-wchwts.adb +++ b/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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index df006b69119..506bdf836fb 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-07-16 Hristian Kirtchev + + * gnat.dg/wide_wide_value1.adb: New testcase. + 2018-07-16 Javier Miranda * gnat.dg/bit_order1.adb: New testcase. diff --git a/gcc/testsuite/gnat.dg/wide_wide_value1.adb b/gcc/testsuite/gnat.dg/wide_wide_value1.adb new file mode 100644 index 00000000000..28b92226753 --- /dev/null +++ b/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; -- 2.30.2