View Issue Details

IDProjectCategoryView StatusLast Update
0021460FPCCompilerpublic2012-03-13 14:33
Reportersyfre Assigned ToJonas Maebe  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionduplicate 
Product Version2.6.1 
Fixed in Version3.0.0 
Summary0021460: As operator on an interface increment the refcount by two
DescriptionUsing implicit cast between object and interface :
  obj := TmyObjectByRefCount.Create; //refcount = 1
  intf := obj; //refcount = 2

Using As operator :
  obj := TmyObjectByRefCount.Create; //refcount = 1
  intf := obj as ImyInterface; //refcount = 3

I suspect the reason is As operator used one local variable which is dereferenced at the end of the block; anyway this may have edge effects when porting from Delphi

Steps To ReproduceMake a dunit project with the join unit
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Relationships

duplicate of 0009472 closedYuriy Sydorov "as" increase .RefCount in INTERFACE 

Activities

2012-03-11 20:20

 

durefcount.pas (2,990 bytes)   
unit durefcount;
interface
uses classes, sysutils, strutils, typinfo, variants
 , forms
  {$IFDEF FPC}
  , fpcunit
  , testregistry
  {$ELSE}
  , TestFrameWork
  {$ENDIF}
  ;

type
  TTestInterfacedObjectPatterns = class(TTestCase)
  public
  published
  procedure Test_ObjectByRefCount_Pattern;
  procedure Test_ObjectByRefCount_Pattern_as_operator;
  procedure Test_Factory_Pattern;
  end;

implementation
var
  glbObjectCount : Integer = 0;

Type
  ImyInterface = interface
  ['{D3E015D1-55F2-4D17-ACDE-528CF3F265E8}']
  end;

  TmyObjectByRefCount = class(TInterfacedObject,ImyInterface)
  public
    constructor Create;
    Destructor Destroy; override;
  end;

  TmyFactory = class(TInterfacedObject,ImyInterface)
  public
    constructor Create;
    Destructor Destroy; override;
  end;

constructor TmyObjectByRefCount.Create;
begin
  // Managed by refCount : call Create / _Release;
  inherited Create;
  _AddRef;
  inc(glbObjectCount);
end;

Destructor TmyObjectByRefCount.Destroy;
begin
  dec(glbObjectCount);
  inherited ;
end;

constructor TmyFactory.Create;
begin
  // Factory : call intf := factory.Create as interface / intf.Release
  inherited Create;
  inc(glbObjectCount);
end;

Destructor TmyFactory.Destroy;
begin
  dec(glbObjectCount);
  inherited ;
end;

//////////////////////////////////////////////////////////////////////////////////

procedure TTestInterfacedObjectPatterns.Test_ObjectByRefCount_Pattern;
var obj:TmyObjectByRefCount; intf:ImyInterface;
begin
  glbObjectCount := 0;
  obj := TmyObjectByRefCount.Create;   //refcount = 1
  Check(glbObjectCount=1,Format('ObjectCount %d',[glbObjectCount]));
  intf := obj;  //refcount = 2
  obj._Release; //refcount = 1
  Check(glbObjectCount=1,Format('ObjectCount %d',[glbObjectCount]));
  intf._Release; //refcount = 0
  Check(glbObjectCount=0,Format('ObjectCount %d',[glbObjectCount]));
  Pointer(intf) := nil;
end;

procedure TTestInterfacedObjectPatterns.Test_ObjectByRefCount_Pattern_as_operator;
var obj:TmyObjectByRefCount; intf:ImyInterface;
begin
  glbObjectCount := 0;
  obj := TmyObjectByRefCount.Create; //refcount = 1
  Check(glbObjectCount=1,Format('ObjectCount %d',[glbObjectCount]));
  intf := obj as ImyInterface; //refcount = 3
  obj._Release;  //refcount = 2
  Check(glbObjectCount=1,Format('ObjectCount %d',[glbObjectCount]));
  intf._Release; //refcount = 1
  Check(glbObjectCount=0,Format('ObjectCount %d',[glbObjectCount])); // failed
  Pointer(intf) := nil;
end;


procedure TTestInterfacedObjectPatterns.Test_Factory_Pattern;
var intf:ImyInterface;
begin
  glbObjectCount := 0;
  intf := TmyFactory.Create as ImyInterface;
  Check(glbObjectCount=1,Format('ObjectCount %d',[glbObjectCount]));
  intf._Release;
  Check(glbObjectCount=0,Format('ObjectCount %d',[glbObjectCount]));  //failed
  Pointer(intf) := nil;
end;


initialization
  {$IFDEF FPC}
  RegisterTest(TTestInterfacedObjectPatterns);
  {$ELSE}
  TestFramework.RegisterTest(TTestInterfacedObjectPatterns.Suite);
  {$ENDIF}
end.
durefcount.pas (2,990 bytes)   

Jonas Maebe

2012-03-13 14:33

manager   ~0057585

Depending on the exact number of reference counts is wrong. We do not guarantee identical absolute reference count values compared to Delphi, or even across different FPC compiler versions. This is an implementation detail that depends on many different factors (such as compiler version and enabled optimizations). See the duplicate bug report for a very long discussion on this topic.

Issue History

Date Modified Username Field Change
2012-03-11 20:20 syfre New Issue
2012-03-11 20:20 syfre File Added: durefcount.pas
2012-03-13 14:33 Jonas Maebe Relationship added duplicate of 0009472
2012-03-13 14:33 Jonas Maebe Duplicate ID 0 => 9472
2012-03-13 14:33 Jonas Maebe Status new => resolved
2012-03-13 14:33 Jonas Maebe Fixed in Version => 2.7.1
2012-03-13 14:33 Jonas Maebe Resolution open => duplicate
2012-03-13 14:33 Jonas Maebe Assigned To => Jonas Maebe
2012-03-13 14:33 Jonas Maebe Note Added: 0057585