paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-05 18:28:51 +01:00
Code Issues Packages Projects Releases Wiki Activity

* TFPHashlist.Pack now also reclaims unused string memory

Browse Source 
git-svn-id: trunk@23252 -
This commit is contained in:
michael 2012-12-29 15:35:02 +00:00
parent 49cb967614
commit 48c3adfdb9
1 changed files with 22 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/fcl-base/src/contnrs.pp
View File

@ -1552,20 +1552,31 @@ var
i : integer;
pdest,
psrc : PHashItem;
FOldStr : Pchar;
begin
NewCount:=0;
psrc:=@FHashList^[0];
pdest:=psrc;
For I:=0 To FCount-1 Do
begin
if assigned(psrc^.Data) then
begin
pdest^:=psrc^;
inc(pdest);
inc(NewCount);
end;
inc(psrc);
end;
FOldStr:=FStrs;
try
FStrs:=Nil;
FStrCount:=0;
FStrCapacity:=0;
pdest:=psrc;
For I:=0 To FCount-1 Do
begin
if assigned(psrc^.Data) then
begin
pdest^:=psrc^;
Pdest^.strindex:=AddStr(PShortString(@FOldStr[PDest^.StrIndex])^);
inc(pdest);
inc(NewCount);
end;
inc(psrc);
end;
finally
FreeMem(FoldStr);
end;
FCount:=NewCount;
{ We need to ReHash to update the IndexNext }
ReHash;