[gcc(refs/users/guojiufu/heads/personal-branch)] [Ada] Unbounded string overriding control
Jiu Fu Guo
guojiufu@gcc.gnu.org
Mon Aug 10 07:22:41 GMT 2020
https://gcc.gnu.org/g:21717db17a8264b7f75366aafa3d21afce5dd41b
commit 21717db17a8264b7f75366aafa3d21afce5dd41b
Author: Dmitriy Anisimkov <anisimko@adacore.com>
Date: Thu May 21 18:15:40 2020 +0600
[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:
---
gcc/ada/libgnat/a-strunb.adb | 83 +++++++++++++++++++++++----
gcc/ada/libgnat/a-strunb__shared.adb | 105 ++++++++++++++++++++++++++---------
2 files changed, 150 insertions(+), 38 deletions(-)
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
More information about the Gcc-cvs
mailing list