[fpc-pascal] TInterfacedObject destructor reentrance bug

[African Wild Dog]

Hello,

I have found a bug in the TInterfacedObject.

Better than explaining is to examine and execute the code below.
When executing the code below the destructor of the class
TCustomDestructorClass is called infinitely.
This is due to calling the procedure Foo inside the destructor of
TCustomDestructorClass, whhich causes the _addRef and _Release methods to
be called again. As the reference count reaches zero again, this triggers
the calling of the destructor again e and so the cycle will repeat
infinitely.

I think one solution would be the _Release method to check if the instance
is already being destroyed before calling the destructor of the class
(Destroy method). Currently the method only checks if the reference count
reaches zero.

==== CODE BEGIN =========

program interfaced_object_error_2;

type

  { TCustomDeestructorClass }

  TCustomDestructorClass = class(TInterfacedObject)
  public
    destructor Destroy; override;
  end;

var
  DestrcutorCount: Integer = 0;
  CustomRef: IInterface;

procedure Foo(Value: IInterface);
begin
  if Value <> nil then
    Inc(DestrcutorCount);
end;

{ TCustomDeestructorClass }

destructor TCustomDestructorClass.Destroy;
begin
  Foo(Self);
  inherited Destroy;
end;

begin
  CustomRef := TCustomDestructorClass.Create;
  CustomRef := TCustomDestructorClass.Create; // Forces execution of
destructor
end.

=== END ===========
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20170715/29437645/attachment.html>