Why Gemfury? Push, build, and install  RubyGems npm packages Python packages Maven artifacts PHP packages Go Modules Debian packages RPM packages NuGet packages

Repository URL to install this package:

Details    
fpc-src / usr / share / fpcsrc / 3.2.0 / tests / webtbs / tw1677.pp
Size: Mime:
{ 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.