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
+
---------
-- "&" --
---------
Result : Unbounded_String;
begin
- Result.Last := L_Length + R_Length;
+ Result.Last := Sum (L_Length, R_Length);
Result.Reference := new String (1 .. Result.Last);
Result : Unbounded_String;
begin
- Result.Last := L_Length + Right'Length;
+ Result.Last := Sum (L_Length, Right'Length);
Result.Reference := new String (1 .. Result.Last);
Result : Unbounded_String;
begin
- Result.Last := Left'Length + R_Length;
+ Result.Last := Sum (Left'Length, R_Length);
Result.Reference := new String (1 .. Result.Last);
Result : Unbounded_String;
begin
- Result.Last := Left.Last + 1;
+ Result.Last := Sum (Left.Last, 1);
Result.Reference := new String (1 .. Result.Last);
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;
Result : Unbounded_String;
begin
- Result.Last := Left;
+ Result.Last := Left;
Result.Reference := new String (1 .. Left);
for J in Result.Reference'Range loop
Result : Unbounded_String;
begin
- Result.Last := Left * Len;
+ Result.Last := Mul (Left, Len);
Result.Reference := new String (1 .. Result.Last);
Result : Unbounded_String;
begin
- Result.Last := Left * Len;
+ Result.Last := Mul (Left, Len);
Result.Reference := new String (1 .. Result.Last);
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 --
---------------
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);
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 --
--------------------------
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 --
----------
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));
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));
-- 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.
+
---------
-- "&" --
---------
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
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
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
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
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
(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;
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;
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;
--------------
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 --
------------
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
-- 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;
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
-- 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;
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;
-- 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) :=
-- 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) :=
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 --
---------------
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
-- 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.
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 --
----------
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
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