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:
parent
e549026c61
commit
8136fcaff7
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue