* synchronized with trunk

git-svn-id: branches/z80@44609 -
This commit is contained in:
nickysn 2020-04-05 20:52:53 +00:00
commit 052bc6c5e8
4 changed files with 94 additions and 7 deletions

2
.gitattributes vendored
View File

@ -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

View File

@ -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
View 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
View 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.