[Ada] Segmentation_Fault with Integer'Wide_Wide_Value

Message ID 20180716141410.GA59602@adacore.com
State New
Headers show
Series
  • [Ada] Segmentation_Fault with Integer'Wide_Wide_Value
Related show

Commit Message

Pierre-Marie de Rodat July 16, 2018, 2:14 p.m.
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  <kirtchev@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.

Patch

--- 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;