lace.text: Fix several bugs.

This commit is contained in:
Rod Kay
2023-10-17 15:49:12 +11:00
parent bbf195bbe5
commit 85a269be38
6 changed files with 81 additions and 21 deletions

View File

@@ -65,6 +65,8 @@ is
Trim : in Boolean := False;
max_Tokens : in Positive := 8 * 1024) return Array_type
is
begin
declare
the_Tokens : Array_type (1 .. max_Tokens);
Count : Natural := 0;
From : Positive := 1;
@@ -87,10 +89,20 @@ is
end if;
return the_Tokens (1 .. Count);
end;
exception
when storage_Error =>
raise stack_Error with "Stack size exceeded. Increase stack size via '$ ulimit -s unlimited' or similar.";
end any_Tokens_chr;
function Tokens_1 is new any_Tokens_chr (Text_Capacity => 1,
Component => Text.item_1,
Array_type => Text.items_1,
any_to_Text => to_Text);
function Tokens_2 is new any_Tokens_chr (Text_Capacity => 2,
Component => Text.item_2,
Array_type => Text.items_2,
@@ -187,6 +199,10 @@ is
any_to_Text => to_Text);
function Tokens (Self : in Item; Delimiter : in Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_1 renames Tokens_1;
function Tokens (Self : in Item; Delimiter : in Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_2 renames Tokens_2;
@@ -304,6 +320,11 @@ is
function Tokens_1 is new any_Tokens_str (Text_Capacity => 1,
Component => Text.item_1,
Array_type => Text.items_1,
any_to_Text => to_Text);
function Tokens_2 is new any_Tokens_str (Text_Capacity => 2,
Component => Text.item_2,
Array_type => Text.items_2,
@@ -400,6 +421,10 @@ is
any_to_Text => to_Text);
function Tokens (Self : in Item; Delimiter : in String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_1 renames Tokens_1;
function Tokens (Self : in Item; Delimiter : in String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_2 renames Tokens_2;

View File

@@ -1,11 +1,21 @@
package lace.Text.all_Tokens
--
-- Some of these functions require a very large stack size.
-- If a Storage_Error is raised, try setting stack size to 'unlimited'.
--
-- $ ulimit -s unlimited
--
is
default_Max : constant := 8 * 1024;
stack_Error : exception;
----------------------
-- Character Delimiter
--
function Tokens (Self : in Item; Delimiter : in Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_1;
function Tokens (Self : in Item; Delimiter : in Character := ' ';
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_2;
@@ -67,6 +77,9 @@ is
-------------------
-- String Delimiter
--
function Tokens (Self : in Item; Delimiter : in String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_1;
function Tokens (Self : in Item; Delimiter : in String;
Trim : in Boolean := False;
max_Tokens : in Positive := default_Max) return Text.items_2;

View File

@@ -28,6 +28,11 @@ is
Result : sized_String;
i : Natural := 0;
begin
if Length = 0
then
return "";
end if;
open (the_File, in_File, String (Filename));
read (the_File, Pad);
close (the_File);
@@ -71,6 +76,19 @@ is
-- Stock Items
--
function to_Text_1 (From : in String) return Item_1
is
begin
return to_Text (From, capacity => 1);
end to_Text_1;
function to_Text_1 (From : in Text.item) return Item_1
is
begin
return to_Text (to_String (From), capacity => 1);
end to_Text_1;
function to_Text_2 (From : in String) return Item_2
is
begin

View File

@@ -21,6 +21,9 @@ is
-- Stock Items
--
function to_Text_1 (From : in String) return Item_1;
function to_Text_1 (From : in Text.item) return Item_1;
function to_Text_2 (From : in String) return Item_2;
function to_Text_2 (From : in Text.item) return Item_2;

View File

@@ -98,6 +98,7 @@ is
First : Natural := 1;
Last : Natural;
begin
while First <= Self.Length
loop
Last := First + Pattern'Length - 1;
@@ -116,8 +117,6 @@ is
Cursor := Cursor + 1;
First := First + 1;
end if;
exit when First > Self.Length;
end loop;
Self.Length := Cursor - 1;

View File

@@ -21,6 +21,7 @@ is
-- Stock Items
--
subtype Item_1 is Item (Capacity => 1);
subtype Item_2 is Item (Capacity => 2);
subtype Item_4 is Item (Capacity => 4);
subtype Item_8 is Item (Capacity => 8);
@@ -58,6 +59,7 @@ is
-- Stock Arrays
--
type Items_1 is array (Positive range <>) of aliased Item_1;
type Items_2 is array (Positive range <>) of aliased Item_2;
type Items_4 is array (Positive range <>) of aliased Item_4;
type Items_8 is array (Positive range <>) of aliased Item_8;