[Ada] Overflow in string streaming

Message ID 20200716092051.GA146398@adacore.com
State New
Headers show
Series
  • [Ada] Overflow in string streaming
Related show

Commit Message

Pierre-Marie de Rodat July 16, 2020, 9:20 a.m.
The routine to output strings in an optimized manner has an overflow
error in case of very large strings.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* libgnat/s-ststop.ads: Fix typo.
	* libgnat/s-ststop.adb (Read, Write): Fix block number
	computation to avoid overflows in case of large strings.

Patch

diff --git a/gcc/ada/libgnat/s-ststop.adb b/gcc/ada/libgnat/s-ststop.adb
--- a/gcc/ada/libgnat/s-ststop.adb
+++ b/gcc/ada/libgnat/s-ststop.adb
@@ -216,21 +216,25 @@  package body System.Strings.Stream_Ops is
             declare
                --  Determine the size in BITS of the block necessary to contain
                --  the whole string.
+               --  Since we are dealing with strings indexed by natural, there
+               --  is no risk of overflow when using a Long_Long_Integer.
 
-               Block_Size : constant Natural :=
-                              Integer (Item'Last - Item'First + 1) * ET_Size;
+               Block_Size : constant Long_Long_Integer :=
+                 Item'Length * Long_Long_Integer (ET_Size);
 
                --  Item can be larger than what the default block can store,
-               --  determine the number of whole reads necessary to read the
+               --  determine the number of whole writes necessary to output the
                --  string.
 
-               Blocks : constant Natural := Block_Size / Default_Block_Size;
+               Blocks : constant Natural :=
+                 Natural (Block_Size / Long_Long_Integer (Default_Block_Size));
 
                --  The size of Item may not be a multiple of the default block
-               --  size, determine the size of the remaining chunk in BITS.
+               --  size, determine the size of the remaining chunk.
 
                Rem_Size : constant Natural :=
-                            Block_Size mod Default_Block_Size;
+                 Natural
+                   (Block_Size mod Long_Long_Integer (Default_Block_Size));
 
                --  String indexes
 
@@ -337,20 +341,25 @@  package body System.Strings.Stream_Ops is
             declare
                --  Determine the size in BITS of the block necessary to contain
                --  the whole string.
+               --  Since we are dealing with strings indexed by natural, there
+               --  is no risk of overflow when using a Long_Long_Integer.
 
-               Block_Size : constant Natural := Item'Length * ET_Size;
+               Block_Size : constant Long_Long_Integer :=
+                 Item'Length * Long_Long_Integer (ET_Size);
 
                --  Item can be larger than what the default block can store,
                --  determine the number of whole writes necessary to output the
                --  string.
 
-               Blocks : constant Natural := Block_Size / Default_Block_Size;
+               Blocks : constant Natural :=
+                 Natural (Block_Size / Long_Long_Integer (Default_Block_Size));
 
                --  The size of Item may not be a multiple of the default block
                --  size, determine the size of the remaining chunk.
 
                Rem_Size : constant Natural :=
-                            Block_Size mod Default_Block_Size;
+                 Natural
+                   (Block_Size mod Long_Long_Integer (Default_Block_Size));
 
                --  String indexes
 


diff --git a/gcc/ada/libgnat/s-ststop.ads b/gcc/ada/libgnat/s-ststop.ads
--- a/gcc/ada/libgnat/s-ststop.ads
+++ b/gcc/ada/libgnat/s-ststop.ads
@@ -53,7 +53,7 @@ 
 --       or
 --     String_Output_Blk_IO (Some_Stream, Some_String);
 
---  String_Output form is used if pragma Restrictions (No_String_Optimziations)
+--  String_Output form is used if pragma Restrictions (No_String_Optimizations)
 --  is active, which requires element by element operations. The BLK_IO form
 --  is used if this restriction is not set, allowing block optimization.