mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-10 00:29:25 +02:00
6c8eed21c4
+ implement trashing of local variables if subroutine is inlined * fix some errors releated to interproc. gotos and inlining + node_count function * inline cannot be used with iochecking and safecall calling conventions * track inherited usage * don't inline if inherited is used git-svn-id: trunk@21335 -
69 lines
1.2 KiB
ObjectPascal
69 lines
1.2 KiB
ObjectPascal
{ Source provided for Free Pascal Bug Report 1677 }
|
|
{ Submitted by "Anders Lindeberg" on 2001-11-10 }
|
|
{ e-mail: anders.lindeberg@telia.com }
|
|
|
|
{ inlining causes different ref. counting }
|
|
{$inline off}
|
|
program test;
|
|
|
|
type trec = record i:integer; s:ansistring end;
|
|
|
|
procedure RefCount(const s : ansistring;var rc:sizeint;expect:sizeint);
|
|
type
|
|
PLongint = ^Longint;
|
|
var
|
|
P : psizeint;
|
|
begin
|
|
P := psizeint(s);
|
|
rc:=0;
|
|
if (p = nil)
|
|
then writeln('Nil string.')
|
|
else
|
|
{$ifdef fpc}
|
|
rc:=psizeint(pchar(p)-sizeof(sizeint)*2)^;
|
|
{$else}
|
|
rc:=plongint(pchar(p)-8)^;
|
|
{$endif}
|
|
if expect<>-1 then
|
|
begin
|
|
writeln('Ref count is ',rc,' expected ',expect);
|
|
if rc<>expect then
|
|
halt(1);
|
|
end
|
|
else
|
|
writeln('Ref count is ',rc);
|
|
end;
|
|
|
|
|
|
procedure p1(const r:trec);
|
|
begin
|
|
end;
|
|
|
|
procedure p2(r:trec);
|
|
begin
|
|
end;
|
|
|
|
procedure p3(const a:ansistring);
|
|
begin
|
|
end;
|
|
|
|
procedure p4(a:ansistring);
|
|
begin
|
|
end;
|
|
|
|
var r:trec; s:ansistring;
|
|
hrc,rc : sizeint;
|
|
begin
|
|
s:=chr(ord('A')+random(26));
|
|
r.s:=s;
|
|
writeln('init');
|
|
RefCount(s,rc,-1);
|
|
writeln('p1()');
|
|
p1(r);
|
|
RefCount(s,hrc,rc);
|
|
writeln('p2()');
|
|
p2(r);
|
|
RefCount(s,hrc,rc);
|
|
writeln('ok');
|
|
end.
|