mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 22:47:59 +02:00
* synchronized with trunk
git-svn-id: branches/z80@44609 -
This commit is contained in:
commit
052bc6c5e8
2
.gitattributes
vendored
2
.gitattributes
vendored
@ -16876,6 +16876,7 @@ tests/webtbs/tw14236.pp svneol=native#text/plain
|
||||
tests/webtbs/tw1430.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14307.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14315.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14315b.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw1433.pp svneol=native#text/plain
|
||||
tests/webtbs/tw14347.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw14363.pp svneol=native#text/plain
|
||||
@ -18177,6 +18178,7 @@ tests/webtbs/tw36738.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3676.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3681.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3683.pp svneol=native#text/plain
|
||||
tests/webtbs/tw36863.pp svneol=native#text/pascal
|
||||
tests/webtbs/tw3687.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3691.pp svneol=native#text/plain
|
||||
tests/webtbs/tw3694.pp svneol=native#text/plain
|
||||
|
@ -649,13 +649,21 @@ implementation
|
||||
|
||||
block:=nil;
|
||||
stat:=nil;
|
||||
self_temp:=nil;
|
||||
if docheck then
|
||||
begin
|
||||
{ check for nil self-pointer }
|
||||
block:=internalstatements(stat);
|
||||
self_temp:=ctempcreatenode.create_value(
|
||||
self_resultdef,self_resultdef.size,tt_persistent,true,
|
||||
self_node);
|
||||
if is_object(self_resultdef) then
|
||||
begin
|
||||
self_temp:=ctempcreatenode.create_value(
|
||||
cpointerdef.getreusable(self_resultdef),cpointerdef.getreusable(self_resultdef).size,tt_persistent,true,
|
||||
caddrnode.create(self_node));
|
||||
end
|
||||
else
|
||||
self_temp:=ctempcreatenode.create_value(
|
||||
self_resultdef,self_resultdef.size,tt_persistent,true,
|
||||
self_node);
|
||||
addstatement(stat,self_temp);
|
||||
|
||||
{ in case of an object, self can only be nil if it's a dereferenced
|
||||
@ -665,8 +673,6 @@ implementation
|
||||
(actualtargetnode(@self_node)^.nodetype=derefn) then
|
||||
begin
|
||||
check_self:=ctemprefnode.create(self_temp);
|
||||
if is_object(self_resultdef) then
|
||||
check_self:=caddrnode.create(check_self);
|
||||
addstatement(stat,cifnode.create(
|
||||
caddnode.create(equaln,
|
||||
ctypeconvnode.create_explicit(
|
||||
@ -678,8 +684,10 @@ implementation
|
||||
nil)
|
||||
);
|
||||
end;
|
||||
addstatement(stat,ctempdeletenode.create_normal_temp(self_temp));
|
||||
self_node:=ctemprefnode.create(self_temp);
|
||||
if is_object(self_resultdef) then
|
||||
self_node:=cderefnode.create(ctemprefnode.create(self_temp))
|
||||
else
|
||||
self_node:=ctemprefnode.create(self_temp)
|
||||
end;
|
||||
{ in case of a classref, the "instance" is a pointer
|
||||
to pointer to a VMT and there is no vmt field }
|
||||
@ -729,6 +737,7 @@ implementation
|
||||
)
|
||||
);
|
||||
addstatement(stat,ctempdeletenode.create_normal_temp(vmt_temp));
|
||||
addstatement(stat,ctempdeletenode.create(self_temp));
|
||||
addstatement(stat,ctemprefnode.create(vmt_temp));
|
||||
result:=block;
|
||||
end
|
||||
|
46
tests/webtbs/tw14315b.pp
Normal file
46
tests/webtbs/tw14315b.pp
Normal file
@ -0,0 +1,46 @@
|
||||
program Project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
function RandomRange(const low : longint;
|
||||
const high : longint) : longint;
|
||||
begin
|
||||
if (high < low) then
|
||||
result := high + random(low - high + 1)
|
||||
else
|
||||
Result := low + random(high - low + 1);
|
||||
end;
|
||||
|
||||
procedure GetStats(out used: ptruint);
|
||||
var
|
||||
fpcHeapStatus : TFPCHeapStatus;
|
||||
begin
|
||||
fpcHeapStatus := GetFPCHeapStatus();
|
||||
used:=fpcHeapStatus.CurrHeapUsed;
|
||||
writeln(' heap status: cu=' +
|
||||
IntToStr(fpcHeapStatus.CurrHeapUsed) + ', cs=' +
|
||||
IntToStr(fpcHeapStatus.CurrHeapSize) + ', cf=' +
|
||||
IntToStr(fpcHeapStatus.CurrHeapFree) + ', mu=' +
|
||||
IntToStr(fpcHeapStatus.MaxHeapUsed) + ', ms=' +
|
||||
IntToStr(fpcHeapStatus.MaxHeapSize));
|
||||
end;
|
||||
|
||||
var
|
||||
i : integer;
|
||||
a : array of byte;
|
||||
u1, u2: ptruint;
|
||||
begin
|
||||
randseed:=1586103426;
|
||||
writeln('randseed: ',randseed);
|
||||
GetStats(u1);
|
||||
for i := 0 to 50 do begin
|
||||
SetLength(a, RandomRange(1024,1024*1024*15));
|
||||
end;
|
||||
SetLength(a, 0);
|
||||
GetStats(u2);
|
||||
if u1<>u2 then
|
||||
halt(1);
|
||||
end.
|
30
tests/webtbs/tw36863.pp
Normal file
30
tests/webtbs/tw36863.pp
Normal file
@ -0,0 +1,30 @@
|
||||
{ %OPT=-Ct -CR }
|
||||
{$M 65536,65536}
|
||||
|
||||
type
|
||||
TObj = object
|
||||
v: array [0..$2000] of Byte;
|
||||
procedure Proc(depth: Integer);
|
||||
procedure VProc; virtual;
|
||||
end;
|
||||
|
||||
procedure TObj.VProc;
|
||||
begin
|
||||
end;
|
||||
|
||||
procedure TObj.Proc(depth: Integer);
|
||||
begin
|
||||
{stack is eaten here on the function entry}
|
||||
if (depth < 64) then
|
||||
Proc(depth+1);
|
||||
{do not actually call the method since the obj is not initialized, just for minimal demonstration}
|
||||
if (depth < 0) then
|
||||
VProc;
|
||||
end;
|
||||
|
||||
var
|
||||
Obj: TObj;
|
||||
begin
|
||||
Obj.Proc(0);
|
||||
writeln('Completed');
|
||||
end.
|
Loading…
Reference in New Issue
Block a user