hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed a buffer growth bug in Replace for Elastic_String

Browse Source
This commit is contained in:
hyung-hwan 2021-10-03 16:53:13 +00:00
parent f5311ecb69
commit 2e729db43e
4 changed files with 91 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
lib2/h3-strings.adb
View File

@ -1,19 +1,19 @@
with Ada.Unchecked_Deallocation;
package body H3.Strings is
BUFFER_ALIGN: constant := 16;
BUFFER_ALIGN: constant := 128; -- TODO: change it to a reasonably large value.
type Shift_Direction is (SHIFT_LEFT, SHIFT_RIGHT);
function To_Character_Array (Str: in Elastic_String) return Character_Array is
function To_Item_Array (Str: in Elastic_String) return Item_Array is
begin
return Str.Buffer.Slot(Str.Buffer.Slot'First .. Str.Buffer.Last);
end To_Character_Array;
end To_Item_Array;
-- return the buffer capacity excluding the terminator
function Get_Capacity (Str: in Elastic_String) return System_Size is
begin
return Str.Buffer.Slot'Length - 1;
return Str.Buffer.Slot'Length - Terminator_Length;
end Get_Capacity;
-- private. return the buffer capacity including the terminator
@ -38,16 +38,16 @@ package body H3.Strings is
return Str.Buffer.Last;
end Get_Last_Index;
function Get_Item (Str: in Elastic_String; Pos: in System_Index) return Character_Type is
function Get_Item (Str: in Elastic_String; Pos: in System_Index) return Item_Type is
begin
return Str.Buffer.Slot(Pos);
end Get_Item;
-- unsafe as it exposes the internal buffer which can go away.
-- assume the system address is equal to the thin pointer in size.
function Get_Slot_Pointer (Str: in Elastic_String) return Thin_Character_Array_Pointer is
function Get_Slot_Pointer (Str: in Elastic_String) return Thin_Item_Array_Pointer is
A: System.Address := Str.Buffer.Slot(Str.Buffer.Slot'First)'Address;
P: Thin_Character_Array_Pointer;
P: Thin_Item_Array_Pointer;
for P'Address use A'Address;
pragma Import (Ada, P);
begin
@ -165,7 +165,7 @@ package body H3.Strings is
<<COPY_OVER>>
if Shift_Pos <= 0 then
-- no shift is required. copy the entire string including th
Str.Buffer.Slot(First .. Last + 1) := Tmp.Buffer.Slot(First .. Last + 1);
Str.Buffer.Slot(First .. Last + Terminator_Length) := Tmp.Buffer.Slot(First .. Last + Terminator_Length);
Str.Buffer.Last := Last;
return;
end if;
@ -178,12 +178,12 @@ package body H3.Strings is
Mid: System_Size := Shift_Pos - Shift_Size;
begin
Str.Buffer.Slot(First .. Mid) := Tmp.Buffer.Slot(First .. Mid);
Str.Buffer.Slot(Mid + 1 .. Last - Shift_Size + 1) := Tmp.Buffer.Slot(Shift_Pos + 1 .. Last + 1);
Str.Buffer.Slot(Mid + 1 .. Last - Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos + 1 .. Last + Terminator_Length);
Str.Buffer.Last := Last - Shift_Size;
end;
else
Str.Buffer.Slot(First .. Shift_Pos - 1) := Tmp.Buffer.Slot(First .. Shift_Pos - 1);
Str.Buffer.Slot(Shift_Pos + Shift_Size .. Last + Shift_Size + 1) := Tmp.Buffer.Slot(Shift_Pos .. Last + 1);
Str.Buffer.Slot(Shift_Pos + Shift_Size .. Last + Shift_Size + Terminator_Length) := Tmp.Buffer.Slot(Shift_Pos .. Last + Terminator_Length);
Str.Buffer.Last := Last + Shift_Size;
end if;
end Prepare_Buffer;
@ -200,7 +200,12 @@ package body H3.Strings is
Str.Buffer := Empty_Buffer'Access;
end Purge;
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Character_Type; Repeat: in System_Size := 1) is
function Calc_Inc_Capa (Str: in Elastic_String; Inc: in System_Size) return System_Size is
begin
return H3.Align(Get_Length(Str) + Inc + Terminator_Length, BUFFER_ALIGN);
end Calc_Inc_Capa;
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1) is
Act_Pos: System_Index := Pos;
Act_Inc: System_Size := Repeat;
begin
@ -208,43 +213,43 @@ package body H3.Strings is
Act_Pos := Str.Buffer.Last + 1;
end if;
Prepare_Buffer (Str, H3.Align(Get_Length(Str) + Act_Inc + 1, BUFFER_ALIGN), Act_Pos, Act_Inc);
Prepare_Buffer (Str, Calc_Inc_Capa(Str, Act_Inc), Act_Pos, Act_Inc);
Str.Buffer.Slot(Act_Pos .. Act_Pos + Act_Inc - 1) := (others => V);
end Insert;
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Character_Array) is
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Item_Array) is
Act_Pos: System_Index := Pos;
begin
if Act_Pos > Str.Buffer.Last then
Act_Pos := Str.Buffer.Last + 1;
end if;
Prepare_Buffer (Str, H3.Align(Get_Length(Str) + V'Length + 1, BUFFER_ALIGN), Act_Pos, V'Length);
Prepare_Buffer (Str, Calc_Inc_Capa(Str, V'Length), Act_Pos, V'Length);
Str.Buffer.Slot(Act_Pos .. Act_Pos + V'Length - 1) := V;
end Insert;
-- TODO: operator "&" that returns a new Elastic_String
procedure Append (Str: in out Elastic_String; V: in Character_Type; Repeat: in System_Size := 1) is
procedure Append (Str: in out Elastic_String; V: in Item_Type; Repeat: in System_Size := 1) is
begin
Insert (Str, Get_Last_Index(Str) + 1, V, Repeat);
end Append;
procedure Append (Str: in out Elastic_String; V: in Character_Array) is
procedure Append (Str: in out Elastic_String; V: in Item_Array) is
begin
Insert (Str, Get_Last_Index(Str) + 1, V);
end Append;
procedure Prepend (Str: in out Elastic_String; V: in Character_Type; Repeat: in System_Size := 1) is
procedure Prepend (Str: in out Elastic_String; V: in Item_Type; Repeat: in System_Size := 1) is
begin
Insert (Str, Get_First_Index(Str), V, Repeat);
end Prepend;
procedure Prepend (Str: in out Elastic_String; V: in Character_Array) is
procedure Prepend (Str: in out Elastic_String; V: in Item_Array) is
begin
Insert (Str, Get_First_Index(Str), V);
end Prepend;
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Character_Type; Repeat: in System_Size := 1) is
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1) is
Act_To_Pos, Repl_Len: System_Size;
begin
if From_Pos <= To_Pos and then From_Pos <= Str.Buffer.Last then
@ -258,7 +263,7 @@ package body H3.Strings is
Prepare_Buffer (Str, Get_Hard_Capacity(Str), Act_To_Pos, Repl_Len - Repeat, SHIFT_LEFT);
Act_To_Pos := From_Pos + Repeat - 1;
elsif Repeat > Repl_Len then
Prepare_Buffer (Str, Get_Hard_Capacity(Str), From_Pos, Repeat - Repl_Len, SHIFT_RIGHT);
Prepare_Buffer (Str, Calc_Inc_Capa(Str, Repeat - Repl_Len), From_Pos, Repeat - Repl_Len, SHIFT_RIGHT);
Act_To_Pos := From_Pos + Repeat - 1;
else
Prepare_Buffer (Str);
@ -267,7 +272,7 @@ package body H3.Strings is
end if;
end Replace;
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Character_Array) is
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array) is
Act_To_Pos, Repl_Len: System_Size;
begin
if From_Pos <= To_Pos and then From_Pos <= Str.Buffer.Last then
@ -281,7 +286,7 @@ package body H3.Strings is
Prepare_Buffer (Str, Get_Hard_Capacity(Str), Act_To_Pos, Repl_Len - V'Length, SHIFT_LEFT);
Act_To_Pos := From_Pos + V'Length - 1;
elsif V'Length > Repl_Len then
Prepare_Buffer (Str, Get_Hard_Capacity(Str), From_Pos, V'Length - Repl_Len, SHIFT_RIGHT);
Prepare_Buffer (Str, Calc_Inc_Capa(Str, V'Length - Repl_Len), From_Pos, V'Length - Repl_Len, SHIFT_RIGHT);
Act_To_Pos := From_Pos + V'Length - 1;
else
Prepare_Buffer (Str);
@ -307,7 +312,7 @@ package body H3.Strings is
return Str.Buffer = Str2.Buffer or else Str.Buffer.Slot(Get_First_Index(Str) .. Get_Last_Index(Str)) = Str2.Buffer.Slot(Get_First_Index(Str2) .. Get_Last_Index(Str2));
end "=";
function "=" (Str: in Elastic_String; Str2: in Character_Array) return Standard.Boolean is
function "=" (Str: in Elastic_String; Str2: in Item_Array) return Standard.Boolean is
begin
return Str.Buffer.Slot(Get_First_Index(Str) .. Get_Last_Index(Str)) = Str2;
end "=";
@ -331,4 +336,5 @@ package body H3.Strings is
begin
Unref_Buffer (Str.Buffer);
end Finalize;
end H3.Strings;

49
lib2/h3-strings.ads
View File

@ -1,19 +1,23 @@
with Ada.Finalization;
generic
--type Character_Type is private;
type Character_Type is (<>);
Terminator: Character_Type;
--type Item_Type is private;
type Item_Type is (<>);
G_Terminator_Length: System_Zero_Or_One;
G_Terminator_Value: Item_Type;
package H3.Strings is
Terminator_Length: constant System_Zero_Or_One := G_Terminator_Length;
Terminator_Value: constant Item_Type := G_Terminator_Value;
type Elastic_String is private;
type Character_Array is array(System_Index range <>) of Character_Type;
--type Character_Array_Pointer is access all Character_Array;
type Item_Array is array(System_Index range <>) of Item_Type;
--type Item_Array_Pointer is access all Item_Array;
subtype Thin_Character_Array is Character_Array(System_Index'Range);
type Thin_Character_Array_Pointer is access Thin_Character_Array;
subtype Thin_Item_Array is Item_Array(System_Index'Range);
type Thin_Item_Array_Pointer is access Thin_Item_Array;
function To_Character_Array (Str: in Elastic_String) return Character_Array;
function To_Item_Array (Str: in Elastic_String) return Item_Array;
function Get_Capacity (Str: in Elastic_String) return System_Size;
pragma Inline (Get_Capacity);
@ -29,47 +33,48 @@ package H3.Strings is
function Get_Last_Index (Str: in Elastic_String) return System_Size;
pragma Inline (Get_Last_index);
function Get_Item (Str: in Elastic_String; Pos: in System_Index) return Character_Type;
function Get_Item (Str: in Elastic_String; Pos: in System_Index) return Item_Type;
pragma Inline (Get_Item);
-- unsafe
function Get_Slot_Pointer (Str: in Elastic_String) return Thin_Character_Array_Pointer;
function Get_Slot_Pointer (Str: in Elastic_String) return Thin_Item_Array_Pointer;
pragma Inline (Get_Slot_Pointer);
function Is_Shared(Str: in Elastic_String) return Standard.Boolean;
pragma Inline (Is_Shared);
procedure Purge (Str: in out Elastic_String);
procedure Clear (Str: in out Elastic_String);
procedure Purge (Str: in out Elastic_String); -- clear and reset the buffer to Empty_Buffer.
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Character_Type; Repeat: in System_Size := 1);
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Character_Array);
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Item_Type; Repeat: in System_Size := 1);
procedure Insert (Str: in out Elastic_String; Pos: in System_Index; V: in Item_Array);
procedure Append (Str: in out Elastic_String; V: in Character_Type; Repeat: in System_Size := 1);
procedure Append (Str: in out Elastic_String; V: in Character_Array);
procedure Append (Str: in out Elastic_String; V: in Item_Type; Repeat: in System_Size := 1);
procedure Append (Str: in out Elastic_String; V: in Item_Array);
procedure Prepend (Str: in out Elastic_String; V: in Character_Type; Repeat: in System_Size := 1);
procedure Prepend (Str: in out Elastic_String; V: in Character_Array);
procedure Prepend (Str: in out Elastic_String; V: in Item_Type; Repeat: in System_Size := 1);
procedure Prepend (Str: in out Elastic_String; V: in Item_Array);
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Character_Type; Repeat: in System_Size := 1);
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Character_Array);
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Type; Repeat: in System_Size := 1);
procedure Replace (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size; V: in Item_Array);
procedure Delete (Str: in out Elastic_String; From_Pos: in System_Index; To_Pos: in System_Size);
function "=" (Str: in Elastic_String; Str2: in Elastic_String) return Standard.Boolean;
function "=" (Str: in Elastic_String; Str2: in Character_Array) return Standard.Boolean;
function "=" (Str: in Elastic_String; Str2: in Item_Array) return Standard.Boolean;
private
type Buffer_Record(Capa: System_Size) is limited record
Refs: System_Size := 1;
Slot: Character_Array(1 .. Capa);
Slot: Item_Array(1 .. Capa) := (others => Terminator_Value);
Last: System_Size := 0;
end record;
type Buffer_Pointer is access all Buffer_Record;
--Empty_Buffer: aliased Buffer_Record(1);
Empty_Buffer: aliased Buffer_Record := (Capa => 1, Refs => 0, Slot => (1 => Terminator), Last => 0);
-- Use 1 slot to hold the terminator value regardless of th terminator length in Empty_Buffer.
Empty_Buffer: aliased Buffer_Record := (Capa => 1, Refs => 0, Slot => (1 => Terminator_Value), Last => 0);
type Elastic_String is new Ada.Finalization.Controlled with record
Buffer: Buffer_Pointer := Empty_Buffer'Access;

2
lib2/h3.ads
View File

@ -25,6 +25,8 @@ package H3 is
--subtype System_Index is System_Size range 0 .. (System_Size'Last - 1);
subtype System_Index is System_Size range (System_Size'First + 1) .. System_Size'Last;
subtype System_Zero_Or_One is System_Word range 0 .. 1;
type Storage_Pool_Pointer is access all System.Storage_Pools.Root_Storage_Pool'Class;
type System_Byte_Array is array(System_Index range<>) of System_Byte;

43
lib2/hello.adb
View File

@ -12,8 +12,10 @@ with Ada.Wide_Text_IO;
with Ada.Assertions;
use type H3.System_Size;
procedure hello is
package S is new H3.Strings(Wide_Character, Wide_Character'Val(0));
package S is new H3.Strings(Standard.Wide_Character, 1, Wide_Character'Val(0));
package S_I is new H3.Strings(Integer, 1, 16#FF#);
--type Global_Pool is new System.Storage_Pools.Root_Storage_Pool with null record;
P1: aliased System.Pool_Global.Unbounded_No_Reclaim_Pool;
@ -60,9 +62,11 @@ procedure hello is
first := S.Get_First_Index(Str);
last := S.Get_Last_Index(Str);
Ada.Text_IO.Put (Name & " len:" & len'Img & " capa:" & capa'Img & " first:" & first'img & " last:" & last'img & " => ");
Ada.Wide_Text_IO.Put_line (Standard.Wide_String(S.To_Character_Array(Str)));
Ada.Wide_Text_IO.Put_line (Standard.Wide_String(S.To_Item_Array(Str)));
pragma Assert (S.Get_Item(Str, S.Get_Last_Index(Str) + 1) = Wide_Character'Val(0));
if S.Terminator_Length > 0 then
pragma Assert (S.Get_Item(Str, S.Get_Last_Index(Str) + 1) = S.Terminator_Value);
end if;
end print_string_info;
begin
@ -170,7 +174,7 @@ begin
declare
-- unsafe way to access the internal buffer.
arr: constant S.Character_Array := S.To_Character_Array(Str);
arr: constant S.Item_Array := S.To_Item_Array(Str);
begin
Ada.Wide_Text_IO.Put ("STR[1] => [");
for i in arr'Range loop
@ -284,7 +288,6 @@ begin
pragma Assert (S.Get_First_Index(Str2) = 1);
pragma Assert (S.Get_Last_Index(Str2) = 107);
pragma Assert (S."="(Str2, "AACCABQh! Hello, world! donkey>donkeyXABCDEEXTRA THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR H3 => ABCDEF"));
--S.Replace (Str2, 10000, 'Q'); -- constraint error
S.Prepend (Str2, '>', 3);
print_string_info (Str2, "Str2");
@ -342,15 +345,22 @@ begin
pragma Assert (S.Get_Last_Index(Str2) = 85);
pragma Assert (S."="(Str2, "Hello, bee! donkey>donkeyXABCDEEXTRA THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR HH"));
S.Replace (Str2, 8, 10, "ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ");
print_string_info (Str2, "Str2");
pragma Assert (S.Get_Length(Str2) = 160);
pragma Assert (S.Get_First_Index(Str2) = 1);
pragma Assert (S.Get_Last_Index(Str2) = 160);
pragma Assert (S."="(Str2, "Hello, ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ! donkey>donkeyXABCDEEXTRA THIS IS FANTASTIC ELASTIC STRING WRITTEN FOR HH"));
declare
arr: constant S.Thin_Character_Array_Pointer := S.Get_Slot_Pointer(Str);
arr2: constant S.Thin_Character_Array_Pointer := S.Get_Slot_Pointer(Str2);
arr: constant S.Thin_Item_Array_Pointer := S.Get_Slot_Pointer(Str);
arr2: constant S.Thin_Item_Array_Pointer := S.Get_Slot_Pointer(Str2);
use type H3.System_Word;
begin
print_string_info (Str, "Str");
Ada.Wide_Text_IO.Put ("STR(By-Pointer) [");
for i in S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + 1 loop -- this must loop to the terminating null.
for i in S.Get_First_Index(Str) .. S.Get_Last_Index(Str) + S.Terminator_Length loop -- this must loop to the terminating null.
Ada.Wide_Text_IO.Put (arr.all(i));
end loop;
Ada.Wide_Text_IO.Put_Line ("]");
@ -358,14 +368,14 @@ begin
print_string_info (Str2, "Str2");
Ada.Wide_Text_IO.Put ("Str2(By-Pointer) ["); -- this must loop to the terminating null.
for i in S.Get_First_Index(Str2) .. S.Get_Last_Index(Str2) + 1 loop
for i in S.Get_First_Index(Str2) .. S.Get_Last_Index(Str2) + S.Terminator_Length loop
Ada.Wide_Text_IO.Put (arr2.all(i));
end loop;
Ada.Wide_Text_IO.Put_Line ("]");
end;
--declare
-- arr: constant Standard.Wide_String := S.To_Character_Array(str);
-- arr: constant Standard.Wide_String := S.To_Item_Array(str);
--begin
-- Ada.Wide_Text_IO.Put_Line (arr);
--end;
@ -403,5 +413,18 @@ begin
Ada.Text_IO.Put_Line(Q.Get_Item_Pointer(T2).X'Img);
end;
declare
t1: S_I.Elastic_String;
begin
S_I.Append (t1, 20, 5);
S_I.Prepend (t1, 30, 2);
Ada.Text_IO.Put_Line ("-------------------------------");
for i in S_I.Get_First_Index(t1) .. S_I.Get_Last_Index(t1) loop
Ada.Text_IO.Put (" " & S_I.Get_Item(t1, i)'Img);
end loop;
Ada.Text_IO.Put_Line ("");
end;
end;