Memory Leak

[xGTx]

This function is causing a horrible memory leak, i am unsure as too why and was hoping you smart people could educate me!

[pascal]function Split(Source : String; Delimiter : String) : TStringList;
Var Cur, NCur:string;
begin
Result := TStringList.Create;
Cur := Source;
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
While Pos(Delimiter, Cur) > 0 Do
Begin
NCur := Copy(Cur, 0, Pos(Delimiter, Cur) - 1);
Result.Add(NCur);
Cur := Copy(Cur, Pos(Delimiter, Cur) + (Length(Delimiter) - 1) + 1, Length(Cur));
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
End;
Result.Free;
end;[/pascal]

[cairnswm]

That shouldn't make a Memory Leak but will probably give Access Violation errors when you try to use the result.

At the end of the function you free the result - what this does is remove the memory you have allocated and effectivly returns an invalid pointer as the result of the function. The Result.Free should be removed and after you have finished using the resultant TStringlist in the calling function, it should be freed.




[pascal]
function Split(Source : String; Delimiter : String) : TStringList;
Var Cur, NCur:string;
begin
Result := TStringList.Create;
Cur := Source;
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
While Pos(Delimiter, Cur) > 0 Do
Begin
NCur := Copy(Cur, 0, Pos(Delimiter, Cur) - 1);
Result.Add(NCur);
Cur := Copy(Cur, Pos(Delimiter, Cur) + (Length(Delimiter) - 1) + 1, Length(Cur));
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
End;
end;

Procedure DoSomthing;
Var
S :TStringlist;
Begin
S := Split(Source, Delimiter);
..
// Do Whatever with S
..
S.Free;
End;
[/pascal]


Note: Have a Look at the CommaText Property of TStringlist for splitting it into tokens.

[xGTx]

Actually, it works fine. But every time its called... a couple KB of memory gets used up and doesnt go back down.

[{MSX}]

It works only becouse there is no memory allocation between the free and the use of the result, but that's definitely wrong.
You should free the result on the caller as cairnswm said, or pass an already created TStringList as a parameter.
I use this second version becouse i prefer the creator of a class to be also responsible for freeing it. It make it easier to avoid memory leaks.

[pascal]
procedure Split(Source : String; Delimiter : String; destination:TStringList);
Var Cur, NCur:string;
begin
Destination.clear;
Cur := Source;
..
..
..
[/pascal]

[Harry Hunt]

Not really related to the memory leak question, but...

I've written a couple of CSV parsers in the past and I always wondered how to make something like that very fast.

I wrote one parser that worked pretty much like xGTx's, one that essentially loops over the entire length of the string (see below) and one that works kinda like the one below but uses pointers instead of string operations.
The pointer one was pretty fast, but if you've ever tried MS Excel's CSV import, you'll be quite impressed and mine wasn't nearly as fast as that.
Any idea how to write a REALLY fast CSV parser?

[pascal]
procedure Split(S: string; Delimiter: string; OutList: TStringList);
var
I: Integer;
Buf: string;
Current: string;
begin
Buf := '';
Current := '';
for I := 1 to Length(S) do
begin
if Length(Buf) = Length(Delimiter) then
Delete(Buf, 1, 1);
Buf := Buf + S[I];
Current := Current + S[I];
if Buf = Delimiter then
begin
Buf := '';
Delete(Current, Length(Current) - (Length(Delimiter) - 1), Length(Delimiter));
OutList.Add(Current);
Current := '';
end
end;
if Length(Current) > 0 then
OutList.Add(Current)
end;
[/pascal]

the code above takes ~460 msecs for 10,000 elements.
xGTx's takes ~16,578 msecs for the same 10,000 elements (I guess because Pos is pretty slow).

[xGTx]

And here I thought Pos was fast haha

Harry, can I use that code?

Edit:

I just tried timing both functions and it appears mine is going almost twice as fast as Harry's.

[pascal]

function TForm1.Split(Source : String; Delimiter : String) : TStringList;
Var Cur, NCur:string;
begin
Result := TStringList.Create;
Cur := Source;
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
While Pos(Delimiter, Cur) > 0 Do
Begin
NCur := Copy(Cur, 0, Pos(Delimiter, Cur) - 1);
Result.Add(NCur);
Cur := Copy(Cur, Pos(Delimiter, Cur) + (Length(Delimiter) - 1) + 1, Length(Cur));
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
End;
Result.Free;
end;


procedure TForm1.Split2(S: string; Delimiter: string; OutList: TStringList);
var
I: Integer;
Buf: string;
Current: string;
begin
Buf := '';
Current := '';
for I := 1 to Length(S) do
begin
if Length(Buf) = Length(Delimiter) then
Delete(Buf, 1, 1);
Buf := Buf + S[I];
Current := Current + S[I];
if Buf = Delimiter then
begin
Buf := '';
Delete(Current, Length(Current) - (Length(Delimiter) - 1), Length(Delimiter));
OutList.Add(Current);
Current := '';
end
end;
if Length(Current) > 0 then
OutList.Add(Current)
end;

procedure TForm1.DoIt();
var blah : string;
test : TStringList;
begin
blah := 'a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a ,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a';
test := TStringList.Create;
test := Split(blah, ',');
end;

procedure TForm1.DoIt2();
var blah : string;
test : TStringList;
begin
blah := 'a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a ,a,a,a,a,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a,a,a,a,a,a, a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a, a,a,a';
test := TStringList.Create;
Split2(blah, ',', test);
test.Free;
end;


procedure TForm1.Button1Click(Sender: TObject);
var i, c1 : integer;
begin
c1 := GetTickCount();
for i := 1 to 2000 do
DoIt();
Button1.Caption := IntToStr(GetTickCount - c1);
end;


procedure TForm1.Button2Click(Sender: TObject);
var i, c1 : integer;
begin
c1 := GetTickCount();
for i := 1 to 2000 do
DoIt2();
Button2.Caption := IntToStr(GetTickCount - c1);
end;
[/pascal]

For my function im getting: 260-280 ms
For harry's im getting: 670-740 ms




Edit again!

Trying with delphi's TStringList.Delimiter thing im getting really fast 125-140ms

[pascal] test := TStringList.Create;
test.Delimiter := ',';
test.DelimitedText := blah;
test.Free;[/pascal]

[Clootie]

Quick test results:

   964 (total items: 110121) - Original split
    71 (total items: 110110) - DelimitedText split
   474 (total items: 110121) - Harry Hunt split

test code:
[pascal]
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TSplitFunction = function (const Source : String; const Delimiter : String): TStringList of object;

TForm1 = class(TForm)
Button1: TButton;
ResultsMemo: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure TestIt(testFunc: TSplitFunction; const FuncInfo: String);
//////
function Split_1(const Source : String; const Delimiter : String) : TStringList;
function Split_2(const Source : String; const Delimiter : String) : TStringList;
function Split_3(const S : String; const Delimiter : String) : TStringList;
public
{ Public declarations }
end;

var
Form1: TForm1;

const
Sconst_init = '0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ';
var
Sconst: String = '0, 1, 2, 3, 4, 5, 6, 7, 8, 9, ';

implementation

uses MMSystem;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
TestIt(Split_1, 'Original split');
TestIt(Split_2, 'DelimitedText split');
TestIt(Split_3, 'Harry Hunt split');
end;


function TForm1.Split_1(const Source, Delimiter: String): TStringList;
var
Cur, NCur: string;
begin
Result := TStringList.Create;
Cur := Source;
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;

While Pos(Delimiter, Cur) > 0 Do
Begin
NCur := Copy(Cur, 0, Pos(Delimiter, Cur) - 1);
Result.Add(NCur);
Cur := Copy(Cur, Pos(Delimiter, Cur) + (Length(Delimiter) - 1) + 1, Length(Cur));
If Pos(Delimiter, Cur) = 0 Then
Begin
Result.Add(Cur);
End;
End;
// Result.Free;
end;

function TForm1.Split_2(const Source, Delimiter: String): TStringList;
var
delBackup: Char;
begin
Assert(Length(Delimiter) = 1);
Result := TStringList.Create;
delBackup:= Result.Delimiter;
Result.Delimiter := Delimiter[1];

Result.DelimitedText:= Source;
Result.Delimiter:= delBackup;
end;

function TForm1.Split_3(const S, Delimiter: String): TStringList;
var
OutList: TStringList;
I: Integer;
Buf: string;
Current: string;
begin
OutList := TStringList.Create;
Buf := '';
Current := '';
for I := 1 to Length(S) do
begin
if Length(Buf) = Length(Delimiter) then
Delete(Buf, 1, 1);
Buf := Buf + S[I];
Current := Current + S[I];
if Buf = Delimiter then
begin
Buf := '';
Delete(Current, Length(Current) - (Length(Delimiter) - 1), Length(Delimiter));
OutList.Add(Current);
Current := '';
end
end;
if Length(Current) > 0 then
OutList.Add(Current);

Result:= OutList;
end;

procedure TForm1.TestIt(testFunc: TSplitFunction; const FuncInfo: String);
var
Time: Cardinal;
i, c: Integer;
m: TStrings;
begin
timeBeginPeriod(1);
Time:= timeGetTime;

c:= 0;
for i:= 0 to 10 do
begin
m:= testFunc(Sconst, ',');
Inc(c, m.Count);
m.Free;
end;

Time:= timeGetTime - Time;
ResultsMemo.Lines.Add(Format('%6d (total items: %d) - %s', [Time, c, FuncInfo]));

timeEndPeriod(0);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
Sconst:= '';
for i:= 0 to 1000 do
Sconst:= Sconst + Sconst_init;
end;

end.
[/pascal]

[Clootie]

NOTE: changing initial state:
(1) shorter string to split
(2) increase number of strings to split
AND RESULT CHANGE DRAMATICALLY!!!

   123 (total items: 111111) - Original split
    68 (total items: 110110) - DelimitedText split
   381 (total items: 111111) - Harry Hunt split

changed parts:
[pascal]
procedure TForm1.TestIt(testFunc: TSplitFunction; const FuncInfo: String);
...
begin
...
for i:= 0 to 1000 do
...
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
...
for i:= 0 to 10 do
...
end;
[/pascal]

[xGTx]

Well these tests seem to prove that TStringList's in-built split method is fastest. But i've had wierd issues in the past where the StringList didnt like to split by chr(0) and it would split by spaces without even being told too...

as seen here:
[pascal]procedure TForm1.Button5Click(Sender: TObject);
var test: string; blah : tstringlist; i, c1 : integer;
begin

for i := 0 to 2000 do
test := test + 'a' + chr(0);

blah := tstringlist.Create;
c1 := gettickcount();
blah.Delimiter := chr(0);
blah.DelimitedText := test;
button5.Caption := inttostr(gettickcount - c1);

showmessage(inttostr(blah.Count));

end;[/pascal]

blah.count is 2.... and the timing is 0. I dont understand why this wont work with chr(0);

[Harry Hunt]

Interesting results. Note that the DelimitedText property will only allow a single character as delimiter whereas both my routine and xGTx's routine will allow a string as delimiter (which is a major slowdown, at least in my routine).

Check out how the DelimitedText feature of the Memo is implemented. This also explains why it won't split by #0 (because it uses null-terminated strings).

[pascal]
procedure TStrings.SetDelimitedText(const Value: string);
var
P, P1: PChar;
S: string;
begin
BeginUpdate;
try
Clear;
P := PChar(Value);
while P^ in [#1..' '] do
{$IFDEF MSWINDOWS}
P := CharNext(P);
{$ELSE}
Inc(P);
{$ENDIF}
while P^ <> #0 do
begin
if P^ = QuoteChar then
S := AnsiExtractQuotedStr(P, QuoteChar)
else
begin
P1 := P;
while (P^ > ' ') and (P^ <> Delimiter) do
{$IFDEF MSWINDOWS}
P := CharNext(P);
{$ELSE}
Inc(P);
{$ENDIF}
SetString(S, P1, P - P1);
end;
Add(S);
while P^ in [#1..' '] do
{$IFDEF MSWINDOWS}
P := CharNext(P);
{$ELSE}
Inc(P);
{$ENDIF}
if P^ = Delimiter then
begin
P1 := P;
{$IFDEF MSWINDOWS}
if CharNext(P1)^ = #0 then
{$ELSE}
Inc(P1);
if P1^ = #0 then
{$ENDIF}
Add('');
repeat
{$IFDEF MSWINDOWS}
P := CharNext(P);
{$ELSE}
Inc(P);
{$ENDIF}
until not (P^ in [#1..' ']);
end;
end;
finally
EndUpdate;
end;
end;
[/pascal]