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

* improvement of r16001 so that allocations even closer to high(ptruint)

Browse Source 
also fail correctly rather than overflowing to 0 bytes (mantis #18690)

git-svn-id: trunk@16877 -
This commit is contained in:
Jonas Maebe 2011-02-04 18:58:21 +00:00
parent 53c2870fab
commit 7cb1c8b586
3 changed files with 20 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -10968,6 +10968,7 @@ tests/webtbs/tw1862.pp svneol=native#text/plain
tests/webtbs/tw18620.pp svneol=native#text/pascal
tests/webtbs/tw1863.pp svneol=native#text/plain
tests/webtbs/tw1867.pp svneol=native#text/plain
tests/webtbs/tw18690.pp svneol=native#text/plain
tests/webtbs/tw1873.pp svneol=native#text/plain
tests/webtbs/tw1883.pp svneol=native#text/plain
tests/webtbs/tw1888.pp svneol=native#text/plain

3
rtl/inc/heap.inc
View File

@ -1045,7 +1045,8 @@ begin
end
else
begin
size := (size+(sizeof(tmemchunk_var_hdr)+(blocksize-1))) and sizemask;
if size < high(ptruint)-((sizeof(tmemchunk_var_hdr)+(blocksize-1))) then
size := (size+(sizeof(tmemchunk_var_hdr)+(blocksize-1))) and sizemask;
result := sysgetmem_var(size);
end;

17
tests/webtbs/tw18690.pp Normal file
View File

@ -0,0 +1,17 @@
Procedure AllocFreeGiB;
var
p: pointer;
RequestedSize: ptruint;
Begin
Writeln('-----------------------------');
RequestedSize:=high(ptruint); // n GiB - 1
Writeln('RequestedSize = ',RequestedSize,' bytes');
getmem(p,RequestedSize);
if (p<>nil) then
halt(1);
End;
Begin
ReturnNilIfGrowHeapFails:=true;
AllocFreeGiB;
End.