paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 05:29:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* allow shrinking ansistrings if at least half of its memory is saved

Browse Source 
git-svn-id: trunk@7468 -
This commit is contained in:
micha 2007-05-25 09:43:36 +00:00
parent a244d54d6f
commit 4a1f828c98
1 changed files with 5 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
rtl/inc/astrings.inc
View File

@ -527,7 +527,7 @@ Procedure fpc_AnsiStr_SetLength (Var S : AnsiString; l : SizeInt);[Public,Alias
} }
Var Var
Temp : Pointer; Temp : Pointer;
lens, lens, lena,
movelen : SizeInt; movelen : SizeInt;
begin begin
if (l>0) then if (l>0) then
@ -541,7 +541,10 @@ begin
else if PAnsiRec(Pointer(S)-FirstOff)^.Ref=1 then else if PAnsiRec(Pointer(S)-FirstOff)^.Ref=1 then
begin begin
Dec(Pointer(S),FirstOff); Dec(Pointer(S),FirstOff);
if AnsiRecLen+L>MemSize(Pointer(s)) then lens:=MemSize(Pointer(s));
lena:=AnsiRecLen+L;
{ allow shrinking string if that saves at least half of current size }
if (lena>lens) or ((lens>32) and (lena<=(lens div 2))) then
reallocmem(pointer(S),AnsiRecLen+L); reallocmem(pointer(S),AnsiRecLen+L);
Inc(Pointer(S),FirstOff); Inc(Pointer(S),FirstOff);
end end