From: Dmitriy Anisimkov Date: Thu, 21 May 2020 12:15:40 +0000 (+0600) Subject: [Ada] Unbounded string overriding control X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=21717db17a8264b7f75366aafa3d21afce5dd41b;p=gcc.git [Ada] Unbounded string overriding control gcc/ada/ * libgnat/a-strunb.adb (Sum, Mul, Saturated_Sum, Saturated_Mul): New routines. Use them when resulting string size more that length of the strings in parameters. (Unbounded_Slice): Use "- 1" instead of "+ 1" in opposite side of condition to avoid overflow. * libgnat/a-strunb__shared.adb (Sum, Mul): New routines. (Allocate): New routine with 2 parameters. Use routine above when resulting string size more that length of the strings in parameters. (Aligned_Max_Length): Do not try to align to more than Natural'Last. (Unbounded_Slice): Use "- 1" instead of "+ 1" in opposite side of condition to avoid overflow. --- diff --git a/gcc/ada/libgnat/a-strunb.adb b/gcc/ada/libgnat/a-strunb.adb index 0164c79f93a..988de424f80 100644 --- a/gcc/ada/libgnat/a-strunb.adb +++ b/gcc/ada/libgnat/a-strunb.adb @@ -35,6 +35,19 @@ with Ada.Unchecked_Deallocation; package body Ada.Strings.Unbounded is + function Sum (Left : Natural; Right : Integer) return Natural with Inline; + -- Returns summary of Left and Right, raise Constraint_Error on overflow + + function Mul (Left, Right : Natural) return Natural with Inline; + -- Returns multiplication of Left and Right, raise Constraint_Error on + -- overflow. + + function Saturated_Sum (Left : Natural; Right : Integer) return Natural; + -- Returns summary of Left and Right or Natural'Last on overflow + + function Saturated_Mul (Left, Right : Natural) return Natural; + -- Returns multiplication of Left and Right or Natural'Last on overflow + --------- -- "&" -- --------- @@ -48,7 +61,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := L_Length + R_Length; + Result.Last := Sum (L_Length, R_Length); Result.Reference := new String (1 .. Result.Last); @@ -68,7 +81,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := L_Length + Right'Length; + Result.Last := Sum (L_Length, Right'Length); Result.Reference := new String (1 .. Result.Last); @@ -86,7 +99,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := Left'Length + R_Length; + Result.Last := Sum (Left'Length, R_Length); Result.Reference := new String (1 .. Result.Last); @@ -104,7 +117,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := Left.Last + 1; + Result.Last := Sum (Left.Last, 1); Result.Reference := new String (1 .. Result.Last); @@ -122,7 +135,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := Right.Last + 1; + Result.Last := Sum (Right.Last, 1); Result.Reference := new String (1 .. Result.Last); Result.Reference (1) := Left; @@ -142,7 +155,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := Left; + Result.Last := Left; Result.Reference := new String (1 .. Left); for J in Result.Reference'Range loop @@ -161,7 +174,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := Left * Len; + Result.Last := Mul (Left, Len); Result.Reference := new String (1 .. Result.Last); @@ -183,7 +196,7 @@ package body Ada.Strings.Unbounded is Result : Unbounded_String; begin - Result.Last := Left * Len; + Result.Last := Mul (Left, Len); Result.Reference := new String (1 .. Result.Last); @@ -718,6 +731,16 @@ package body Ada.Strings.Unbounded is return Source.Last; end Length; + --------- + -- Mul -- + --------- + + function Mul (Left, Right : Natural) return Natural is + pragma Unsuppress (Overflow_Check); + begin + return Left * Right; + end Mul; + --------------- -- Overwrite -- --------------- @@ -783,10 +806,12 @@ package body Ada.Strings.Unbounded is if Chunk_Size > S_Length - Source.Last then declare New_Size : constant Positive := - S_Length + Chunk_Size + (S_Length / Growth_Factor); + Saturated_Sum + (Sum (S_Length, Chunk_Size), S_Length / Growth_Factor); New_Rounded_Up_Size : constant Positive := - ((New_Size - 1) / Min_Mul_Alloc + 1) * Min_Mul_Alloc; + Saturated_Mul + ((New_Size - 1) / Min_Mul_Alloc + 1, Min_Mul_Alloc); Tmp : constant String_Access := new String (1 .. New_Rounded_Up_Size); @@ -847,6 +872,30 @@ package body Ada.Strings.Unbounded is Free (Old); end Replace_Slice; + ------------------- + -- Saturated_Mul -- + ------------------- + + function Saturated_Mul (Left, Right : Natural) return Natural is + begin + return Mul (Left, Right); + exception + when Constraint_Error => + return Natural'Last; + end Saturated_Mul; + + ----------------- + -- Saturated_Sum -- + ----------------- + + function Saturated_Sum (Left : Natural; Right : Integer) return Natural is + begin + return Sum (Left, Right); + exception + when Constraint_Error => + return Natural'Last; + end Saturated_Sum; + -------------------------- -- Set_Unbounded_String -- -------------------------- @@ -882,6 +931,16 @@ package body Ada.Strings.Unbounded is end if; end Slice; + --------- + -- Sum -- + --------- + + function Sum (Left : Natural; Right : Integer) return Natural is + pragma Unsuppress (Overflow_Check); + begin + return Left + Right; + end Sum; + ---------- -- Tail -- ---------- @@ -1047,7 +1106,7 @@ package body Ada.Strings.Unbounded is High : Natural) return Unbounded_String is begin - if Low > Source.Last + 1 or else High > Source.Last then + if Low - 1 > Source.Last or else High > Source.Last then raise Index_Error; else return To_Unbounded_String (Source.Reference.all (Low .. High)); @@ -1061,7 +1120,7 @@ package body Ada.Strings.Unbounded is High : Natural) is begin - if Low > Source.Last + 1 or else High > Source.Last then + if Low - 1 > Source.Last or else High > Source.Last then raise Index_Error; else Target := To_Unbounded_String (Source.Reference.all (Low .. High)); diff --git a/gcc/ada/libgnat/a-strunb__shared.adb b/gcc/ada/libgnat/a-strunb__shared.adb index 272ef43d260..0ff34d817ef 100644 --- a/gcc/ada/libgnat/a-strunb__shared.adb +++ b/gcc/ada/libgnat/a-strunb__shared.adb @@ -56,6 +56,18 @@ package body Ada.Strings.Unbounded is -- allocated memory segments to use memory effectively by Append/Insert/etc -- operations. + function Sum (Left : Natural; Right : Integer) return Natural with Inline; + -- Returns summary of Left and Right, raise Constraint_Error on overflow + + function Mul (Left, Right : Natural) return Natural with Inline; + -- Returns multiplication of Left and Right, raise Constraint_Error on + -- overflow + + function Allocate + (Length, Growth : Natural) return not null Shared_String_Access; + -- Allocates new Shared_String with at least specified Length plus optional + -- Growth. + --------- -- "&" -- --------- @@ -66,7 +78,7 @@ package body Ada.Strings.Unbounded is is LR : constant Shared_String_Access := Left.Reference; RR : constant Shared_String_Access := Right.Reference; - DL : constant Natural := LR.Last + RR.Last; + DL : constant Natural := Sum (LR.Last, RR.Last); DR : Shared_String_Access; begin @@ -104,7 +116,7 @@ package body Ada.Strings.Unbounded is Right : String) return Unbounded_String is LR : constant Shared_String_Access := Left.Reference; - DL : constant Natural := LR.Last + Right'Length; + DL : constant Natural := Sum (LR.Last, Right'Length); DR : Shared_String_Access; begin @@ -136,7 +148,7 @@ package body Ada.Strings.Unbounded is Right : Unbounded_String) return Unbounded_String is RR : constant Shared_String_Access := Right.Reference; - DL : constant Natural := Left'Length + RR.Last; + DL : constant Natural := Sum (Left'Length, RR.Last); DR : Shared_String_Access; begin @@ -168,7 +180,7 @@ package body Ada.Strings.Unbounded is Right : Character) return Unbounded_String is LR : constant Shared_String_Access := Left.Reference; - DL : constant Natural := LR.Last + 1; + DL : constant Natural := Sum (LR.Last, 1); DR : Shared_String_Access; begin @@ -185,7 +197,7 @@ package body Ada.Strings.Unbounded is Right : Unbounded_String) return Unbounded_String is RR : constant Shared_String_Access := Right.Reference; - DL : constant Natural := 1 + RR.Last; + DL : constant Natural := Sum (1, RR.Last); DR : Shared_String_Access; begin @@ -232,7 +244,7 @@ package body Ada.Strings.Unbounded is (Left : Natural; Right : String) return Unbounded_String is - DL : constant Natural := Left * Right'Length; + DL : constant Natural := Mul (Left, Right'Length); DR : Shared_String_Access; K : Positive; @@ -264,7 +276,7 @@ package body Ada.Strings.Unbounded is Right : Unbounded_String) return Unbounded_String is RR : constant Shared_String_Access := Right.Reference; - DL : constant Natural := Left * RR.Last; + DL : constant Natural := Mul (Left, RR.Last); DR : Shared_String_Access; K : Positive; @@ -480,13 +492,16 @@ package body Ada.Strings.Unbounded is function Aligned_Max_Length (Max_Length : Natural) return Natural is Static_Size : constant Natural := - Empty_Shared_String'Size / Standard'Storage_Unit; - -- Total size of all static components - + Empty_Shared_String'Size / Standard'Storage_Unit; + -- Total size of all Shared_String static components begin - return - ((Static_Size + Max_Length - 1) / Min_Mul_Alloc + 2) * Min_Mul_Alloc - - Static_Size; + if Max_Length > Natural'Last - Static_Size then + return Natural'Last; + else + return + ((Static_Size + Max_Length - 1) / Min_Mul_Alloc + 2) * Min_Mul_Alloc + - Static_Size; + end if; end Aligned_Max_Length; -------------- @@ -509,6 +524,23 @@ package body Ada.Strings.Unbounded is end if; end Allocate; + -------------- + -- Allocate -- + -------------- + + function Allocate + (Length, Growth : Natural) return not null Shared_String_Access is + begin + if Natural'Last - Growth < Length then + -- Then Length + Growth would be more than Natural'Last + + return new Shared_String (Integer'Last); + + else + return Allocate (Length + Growth); + end if; + end Allocate; + ------------ -- Append -- ------------ @@ -519,7 +551,7 @@ package body Ada.Strings.Unbounded is is SR : constant Shared_String_Access := Source.Reference; NR : constant Shared_String_Access := New_Item.Reference; - DL : constant Natural := SR.Last + NR.Last; + DL : constant Natural := Sum (SR.Last, NR.Last); DR : Shared_String_Access; begin @@ -544,7 +576,7 @@ package body Ada.Strings.Unbounded is -- Otherwise, allocate new one and fill it else - DR := Allocate (DL + DL / Growth_Factor); + DR := Allocate (DL, DL / Growth_Factor); DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); DR.Data (SR.Last + 1 .. DL) := NR.Data (1 .. NR.Last); DR.Last := DL; @@ -558,7 +590,7 @@ package body Ada.Strings.Unbounded is New_Item : String) is SR : constant Shared_String_Access := Source.Reference; - DL : constant Natural := SR.Last + New_Item'Length; + DL : constant Natural := Sum (SR.Last, New_Item'Length); DR : Shared_String_Access; begin @@ -576,7 +608,7 @@ package body Ada.Strings.Unbounded is -- Otherwise, allocate new one and fill it else - DR := Allocate (DL + DL / Growth_Factor); + DR := Allocate (DL, DL / Growth_Factor); DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); DR.Data (SR.Last + 1 .. DL) := New_Item; DR.Last := DL; @@ -590,20 +622,20 @@ package body Ada.Strings.Unbounded is New_Item : Character) is SR : constant Shared_String_Access := Source.Reference; - DL : constant Natural := SR.Last + 1; + DL : constant Natural := Sum (SR.Last, 1); DR : Shared_String_Access; begin -- Try to reuse existing shared string - if Can_Be_Reused (SR, SR.Last + 1) then + if Can_Be_Reused (SR, DL) then SR.Data (SR.Last + 1) := New_Item; SR.Last := SR.Last + 1; -- Otherwise, allocate new one and fill it else - DR := Allocate (DL + DL / Growth_Factor); + DR := Allocate (DL, DL / Growth_Factor); DR.Data (1 .. SR.Last) := SR.Data (1 .. SR.Last); DR.Data (DL) := New_Item; DR.Last := DL; @@ -1089,7 +1121,7 @@ package body Ada.Strings.Unbounded is -- Otherwise, allocate new shared string and fill it else - DR := Allocate (DL + DL / Growth_Factor); + DR := Allocate (DL, DL / Growth_Factor); DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1); DR.Data (Before .. Before + New_Item'Length - 1) := New_Item; DR.Data (Before + New_Item'Length .. DL) := @@ -1138,7 +1170,7 @@ package body Ada.Strings.Unbounded is -- Otherwise, allocate new shared string and fill it else - DR := Allocate (DL + DL / Growth_Factor); + DR := Allocate (DL, DL / Growth_Factor); DR.Data (1 .. Before - 1) := SR.Data (1 .. Before - 1); DR.Data (Before .. Before + New_Item'Length - 1) := New_Item; DR.Data (Before + New_Item'Length .. DL) := @@ -1158,6 +1190,16 @@ package body Ada.Strings.Unbounded is return Source.Reference.Last; end Length; + --------- + -- Mul -- + --------- + + function Mul (Left, Right : Natural) return Natural is + pragma Unsuppress (Overflow_Check); + begin + return Left * Right; + end Mul; + --------------- -- Overwrite -- --------------- @@ -1178,7 +1220,7 @@ package body Ada.Strings.Unbounded is raise Index_Error; end if; - DL := Integer'Max (SR.Last, Position + New_Item'Length - 1); + DL := Integer'Max (SR.Last, Sum (Position - 1, New_Item'Length)); -- Result is empty string, reuse empty shared string @@ -1329,7 +1371,8 @@ package body Ada.Strings.Unbounded is -- Do replace operation when removed slice is not empty if High >= Low then - DL := By'Length + SR.Last + Low - Integer'Min (High, SR.Last) - 1; + DL := Sum (SR.Last, + By'Length + Low - Integer'Min (High, SR.Last) - 1); -- This is the number of characters remaining in the string after -- replacing the slice. @@ -1473,6 +1516,16 @@ package body Ada.Strings.Unbounded is end if; end Slice; + --------- + -- Sum -- + --------- + + function Sum (Left : Natural; Right : Integer) return Natural is + pragma Unsuppress (Overflow_Check); + begin + return Left + Right; + end Sum; + ---------- -- Tail -- ---------- @@ -1996,7 +2049,7 @@ package body Ada.Strings.Unbounded is begin -- Check bounds - if Low > SR.Last + 1 or else High > SR.Last then + if Low - 1 > SR.Last or else High > SR.Last then raise Index_Error; -- Result is empty slice, reuse empty shared string @@ -2030,7 +2083,7 @@ package body Ada.Strings.Unbounded is begin -- Check bounds - if Low > SR.Last + 1 or else High > SR.Last then + if Low - 1 > SR.Last or else High > SR.Last then raise Index_Error; -- Result is empty slice, reuse empty shared string