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

Merged revisions 784 via svnmerge from

Browse Source 
/trunk

git-svn-id: branches/fixes_2_0@785 -
This commit is contained in:
florian 2005-08-03 20:01:49 +00:00
parent 864f61d68b
commit bf8e5cd9dc
3 changed files with 26 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -5987,6 +5987,7 @@ tests/webtbs/tw4188.pp svneol=native#text/plain
tests/webtbs/tw4199.pp svneol=native#text/plain tests/webtbs/tw4199.pp svneol=native#text/plain
tests/webtbs/tw4202.pp svneol=native#text/plain tests/webtbs/tw4202.pp svneol=native#text/plain
tests/webtbs/tw4215.pp svneol=native#text/plain tests/webtbs/tw4215.pp svneol=native#text/plain
tests/webtbs/tw4247.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain tests/webtbs/ub1873.pp svneol=native#text/plain
tests/webtbs/ub1883.pp svneol=native#text/plain tests/webtbs/ub1883.pp svneol=native#text/plain
tests/webtbs/uw0555.pp svneol=native#text/plain tests/webtbs/uw0555.pp svneol=native#text/plain

15
rtl/inc/heap.inc
View File

@ -1208,16 +1208,13 @@ begin
We first check if the blocks after the current block are free. If not then we We first check if the blocks after the current block are free. If not then we
simply call getmem/freemem to get the new block } simply call getmem/freemem to get the new block }
if check_concat_free_chunk_forward(pcurr,size) then if check_concat_free_chunk_forward(pcurr,size) then
begin repeat
try_concat_free_chunk_forward(pcurr); concat_two_blocks(pcurr,pmemchunk_var(pointer(pcurr)+currsize));
currsize := (pcurr^.size and sizemask); currsize := pcurr^.size and sizemask;
end; until currsize>=size
else
exit;
end; end;
{ not enough space? }
if size>currsize then
exit;
{ is the size smaller then we can adjust the block to that size and insert { is the size smaller then we can adjust the block to that size and insert
the other part into the freelist } the other part into the freelist }
if currsize>size then if currsize>size then

19
tests/webtbs/tw4247.pp Normal file
View File

@ -0,0 +1,19 @@
{ %OPT=-gh }
{ Source provided for Free Pascal Bug Report 4247 }
{ Submitted by "Martin Schreiber" on 2005-08-02 }
{ e-mail: }
program project1;
//compile with -ghl
var
po1,po2: pointer;
begin
getmem(po1,500);
getmem(po2,500);
reallocmem(po1,400);
reallocmem(po1,300);
reallocmem(po1,200);
reallocmem(po1,400); //crash with error 204
reallocmem(po1,600);
freemem(po1,600);
freemem(po2,500);
end.