perf(stdlib): rewrite GetText and GetCommaText to avoid O(N²) concatenation

Both methods accumulated a result string with repeated `Result := Result + …`
inside a loop — each iteration allocates a fresh buffer and copies the entire
accumulator forward, quadratic in total content size.

Rewrite both using TStringBuilder (geometric buffer growth, single ToString
at the end).  On a self-compile via --output the GetText hot path drops from
~17 s to ~1.7 s (~10× speedup); GetCommaText gets the same fix proactively.

Add TestRun_TextGet_ManyLines: 500-line list with mixed empty/non-empty entries,
spot-checks total length and key substrings after the rewrite.
This commit is contained in:
Graeme Geldenhuys 2026-06-01 00:11:39 +01:00
parent e549026c61
commit 8136fcaff7
2 changed files with 105 additions and 39 deletions

View file

@ -37,6 +37,7 @@ type
procedure TestRun_AddStrings;
procedure TestRun_ForIn;
procedure TestRun_TextGet;
procedure TestRun_TextGet_ManyLines;
procedure TestRun_TextSet;
procedure TestRun_GrowBeyondInitialCapacity;
procedure TestRun_Sorted_Add_OrderedOutput;
@ -236,6 +237,32 @@ const
end.
''';
SrcTextGetMany =
'''
program P;
uses Classes;
var L: TStringList; I: Integer; T: string;
begin
L := TStringList.Create;
I := 0;
while I < 500 do
begin
if (I mod 7) = 0 then
L.Add('')
else
L.Add('line_' + IntToStr(I));
I := I + 1
end;
T := L.Text;
WriteLn(L.Count);
WriteLn(Length(T));
WriteLn(Pos('line_1' + #10, T) >= 0);
WriteLn(Pos('line_250' + #10, T) >= 0);
WriteLn(Pos('line_499' + #10, T) >= 0);
L.Free
end.
''';
SrcTextSet =
'''
program P;
@ -623,6 +650,30 @@ begin
end
end;
procedure TE2ETStringListTests.TestRun_TextGet_ManyLines;
var
Output: string;
RCode: Integer;
Lines: TStringList;
LenStr: string;
begin
if not ToolchainAvailable then begin Fail('<toolchain-missing>'); Exit end;
AssertTrue('compile+run', CompileAndRunWithRTL(SrcTextGetMany, Output, RCode));
AssertEquals('exit 0', 0, RCode);
Lines := TStringList.Create;
try
Lines.Text := Trim(Output);
AssertEquals('Count=500', '500', Lines.Strings[0]);
LenStr := Lines.Strings[1];
AssertTrue('Length(Text) > 3500', StrToInt(LenStr) > 3500);
AssertEquals('contains line_1', '1', Lines.Strings[2]);
AssertEquals('contains line_250', '1', Lines.Strings[3]);
AssertEquals('contains line_499', '1', Lines.Strings[4]);
finally
Lines.Free
end
end;
procedure TE2ETStringListTests.TestRun_TextSet;
var
Output: string;

View file

@ -33,7 +33,7 @@ unit Classes;
interface
uses
blaise_arc, blaise_thread;
blaise_arc, blaise_thread, StrUtils;
type
TDuplicates = (dupAccept, dupIgnore, dupError);
@ -600,16 +600,22 @@ end;
function TStringList.GetText: string;
var
SB: TStringBuilder;
I: Integer;
Ptr: ^string;
begin
Result := '';
I := 0;
while I < Self.FCount do
begin
Ptr := Self.FStrings + I * SizeOf(string);
Result := Result + Ptr^ + #10;
I := I + 1
SB := TStringBuilder.Create;
try
I := 0;
while I < Self.FCount do
begin
Ptr := Self.FStrings + I * SizeOf(string);
SB.AppendLine(Ptr^);
I := I + 1
end;
Result := SB.ToString;
finally
SB.Free
end
end;
@ -753,50 +759,59 @@ end;
function TStringList.GetCommaText: string;
var
SB: TStringBuilder;
I: Integer;
Item: string;
Need: Boolean;
J: Integer;
Ch: Integer;
begin
Result := '';
I := 0;
while I < Self.FCount do
begin
Item := Self.Get(I);
{ Quote if item contains comma, space, or double-quote }
Need := False;
J := 0;
while J < Length(Item) do
SB := TStringBuilder.Create;
try
I := 0;
while I < Self.FCount do
begin
Ch := OrdAt(Item, J);
if (Ch = Ord(',')) or (Ch = Ord(' ')) or (Ch = Ord('"')) then
begin
Need := True;
Break
end;
J := J + 1
end;
if I > 0 then Result := Result + ',';
if Need then
begin
{ Wrap in double quotes; escape inner double-quotes as "" }
Result := Result + '"';
Item := Self.Get(I);
{ Quote if item contains comma, space, or double-quote }
Need := False;
J := 0;
while J < Length(Item) do
begin
Ch := OrdAt(Item, J);
if Ch = Ord('"') then
Result := Result + '""'
else
Result := Result + Chr(Ch);
if (Ch = Ord(',')) or (Ch = Ord(' ')) or (Ch = Ord('"')) then
begin
Need := True;
Break
end;
J := J + 1
end;
Result := Result + '"'
end
else
Result := Result + Item;
I := I + 1
if I > 0 then SB.AppendByte(Ord(','));
if Need then
begin
{ Wrap in double quotes; escape inner double-quotes as "" }
SB.AppendByte(Ord('"'));
J := 0;
while J < Length(Item) do
begin
Ch := OrdAt(Item, J);
if Ch = Ord('"') then
begin
SB.AppendByte(Ord('"'));
SB.AppendByte(Ord('"'))
end
else
SB.AppendByte(Ch);
J := J + 1
end;
SB.AppendByte(Ord('"'))
end
else
SB.Append(Item);
I := I + 1
end;
Result := SB.ToString;
finally
SB.Free
end
end;