paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 12:19:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied patch from Luiz Amerigo to have Delphi compatible behaviour when freeing a stringlist (bug 21529)

Browse Source 
git-svn-id: trunk@20570 -
This commit is contained in:
michael 2012-03-22 12:10:06 +00:00
parent d12456c55d
commit d1b209025f
2 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
rtl/objpas/classes/classesh.inc
View File

@ -679,6 +679,7 @@ type
FOwnsObjects : Boolean;
procedure ExchangeItems(Index1, Index2: Integer);
procedure Grow;
procedure InternalClear;
procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
procedure SetSorted(Value: Boolean);
procedure SetCaseSensitive(b : boolean);

46
rtl/objpas/classes/stringl.inc
View File

@ -908,7 +908,28 @@ begin
SetCapacity(NC);
end;
Procedure TStringList.InternalClear;
Var
I: Integer;
begin
if FOwnsObjects then
begin
For I:=0 to FCount-1 do
begin
Flist^[I].FString:='';
freeandnil(Flist^[i].FObject);
end;
end
else
begin
For I:=0 to FCount-1 do
Flist^[I].FString:='';
end;
FCount:=0;
SetCapacity(0);
end;
Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
var
@ -1128,13 +1149,8 @@ end;
destructor TStringList.Destroy;
Var I : Longint;
begin
FOnChange:=Nil;
FOnChanging:=Nil;
Clear;
SetCapacity(0);
InternalClear;
Inherited destroy;
end;
@ -1156,26 +1172,10 @@ end;
Procedure TStringList.Clear;
Var I : longint;
begin
if FCount = 0 then Exit;
Changing;
if FOwnsObjects then
begin
For I:=0 to FCount-1 do
begin
Flist^[I].FString:='';
freeandnil(Flist^[i].FObject);
end;
end
else
begin
For I:=0 to FCount-1 do
Flist^[I].FString:='';
end;
FCount:=0;
SetCapacity(0);
InternalClear;
Changed;
end;