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

* Fixed reallocmem bug #535

Browse Source
This commit is contained in:
michael 1999-08-18 11:28:24 +00:00
parent a0e69fbd00
commit b52b8d7d34
1 changed files with 24 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
rtl/objpas/sysutils.pp
View File

@ -316,24 +316,27 @@ I get a chance I might attempt to incorporate that feature.
procedure ReAllocMem(var P: Pointer; currentSize: longint; newSize: longint); procedure ReAllocMem(var P: Pointer; currentSize: longint; newSize: longint);
var var
newP : Pointer; newP : Pointer;
moveSize : longint;
begin begin
if ((P = nil) and (newSize > 0)) then if (P = nil) then
P := AllocMem(newSize) begin
else if ((P <> nil) and (newSize > 0)) then If NewSize>0 then
begin P := AllocMem(newSize)
newP := AllocMem(newSize); end
if newP <> nil then else
begin begin
if newSize > currentSize then If NewSize>0 then
moveSize := currentSize NewP := AllocMem(newSize)
else else
moveSize := newSize; NewP:=Nil;
Move(P^, newP^, moveSize); if NewSize > currentSize then
FreeMem(P, currentSize); NewSize := currentSize;
P := newP; If NewSize>0 then
end; Move(P^, newP^, NewSize);
end; If CurrentSize>0 then
FreeMem(P, currentSize);
P := newP;
end;
end; end;
@ -348,7 +351,10 @@ Finalization
end. end.
{ {
$Log$ $Log$
Revision 1.29 1999-07-27 13:01:12 peter Revision 1.30 1999-08-18 11:28:24 michael
* Fixed reallocmem bug 535
Revision 1.29 1999/07/27 13:01:12 peter
+ filerec,textrec declarations + filerec,textrec declarations
Revision 1.28 1999/07/08 19:32:36 michael Revision 1.28 1999/07/08 19:32:36 michael