[fpc-pascal] Sigsegv with refcounting interface

[Joao Morais]

Hello list, what's the problem with "RoundThree" procedure (below)?
Here it raises a sigsegv trying to read an internal field. The
difference from "RoundTwo" is that I create an implementation of the
interface within the first param of tinterfacedlist.add method.

Same problem with fpc 2.6.2 and 2.7.1 (from two days ago), i386-win32.

Joao Morais

==============

program project1;

{$mode objfpc}{$H+}

uses
  heaptrc,
  sysutils,
  Classes;

type
  iintf = interface
  ['{9E08FFD2-5AC4-4AE7-B2C6-703D62A10F16}']
    function RefCount: Integer;
  end;

  { tintf }

  tintf = class(TInterfacedObject, iintf)
  public
    constructor Create;
    destructor Destroy; override;
    function RefCount: Integer;
  end;

{ tintf }

constructor tintf.Create;
begin
  inherited Create;
  writeln('tintf "', PtrUInt(Self) ,'" created');
end;

destructor tintf.Destroy;
begin
  writeln('tintf "', PtrUInt(Self) ,'" destroyed');
  inherited Destroy;
end;

function tintf.RefCount: Integer;
begin
  Result := inherited RefCount;
end;

procedure RoundOne;
var
  vintf: TInterfaceList;
  v1: iintf;
begin
  writeln;
  writeln('Round one');
  writeln('---------');
  vintf := TInterfaceList.Create;
  try
    writeln('creating and adding...');
    vintf.Add(tintf.create);
    writeln('retrieving to v1...');
    if vintf[0].QueryInterface(iintf, v1) = S_OK then
    begin
      writeln('trying to write v1.RefCount...');
      writeln('counting: ', v1.RefCount);
    end else
      writeln('problem');
    v1 := nil;
  finally
    FreeAndNil(vintf);
  end;
end;

procedure RoundTwo;
var
  vintf: TInterfaceList;
  v1, v2: iintf;
begin
  writeln;
  writeln('Round two');
  writeln('---------');
  vintf := TInterfaceList.Create;
  try
    writeln('creating...');
    v2 := tintf.Create;
    writeln('adding...');
    vintf.Add(v2);
    writeln('typecasting to v1...');
    v1 := iintf(vintf[0]);
    writeln('trying to write v1.RefCount...');
    writeln('counting: ', v1.RefCount);
    v1 := nil;
    v2 := nil;
  finally
    FreeAndNil(vintf);
  end;
end;

procedure RoundThree;
var
  vintf: TInterfaceList;
  v1: iintf;
begin
  writeln;
  writeln('Round three');
  writeln('-----------');
  vintf := TInterfaceList.Create;
  try
    writeln('creating and adding...');
    vintf.Add(tintf.Create);
    writeln('typecasting to v1...');
    v1 := iintf(vintf[0]);
    writeln('trying to write v1.RefCount...');
    writeln('counting: ', v1.RefCount);
    v1 := nil;
  finally
    FreeAndNil(vintf);
  end;
end;

begin
  RoundOne;
  RoundTwo;
  RoundThree;
end.
_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/mailman/listinfo/fpc-pascal