hängende Interfaces

[Stevie]

Ich würd das ja so implementieren:

Delphi-Quellcode:

unit DisposableObject;

interface

type
  IDisposable = interface
    ['{07751839-9A68-47C0-9116-68D0D5D7956F}']
    procedure Dispose;
  end;

  TDisposableObject = class(TObject, IInterface, IDisposable)
{$IFNDEF AUTOREFCOUNT}
  private const
    objDestroyingFlag = Integer($80000000);
    function GetRefCount: Integer; inline;
{$ENDIF}
  protected
{$IFNDEF AUTOREFCOUNT}
    [Volatile] FRefCount: Integer;
    class procedure __MarkDestroying(const Obj); static; inline;
{$ENDIF}
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    procedure Dispose; virtual;
  public
{$IFNDEF AUTOREFCOUNT}
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read GetRefCount;
{$ENDIF}
  end;

procedure DisposeAndNil(var intf);

implementation

procedure DisposeAndNil(var intf);
var
  disposable: Pointer;
begin
  if Assigned(IInterface(intf)) and (IInterface(intf).QueryInterface(IDisposable, disposable) = 0) then
  begin
    IInterface(intf) := nil;
    IDisposable(disposable).Dispose;
    IDisposable(disposable) := nil;
  end;
end;

{ TDisposableObject }

{$IFNDEF AUTOREFCOUNT}

function TDisposableObject.GetRefCount: Integer;
begin
  Result := FRefCount and not objDestroyingFlag;
end;

class procedure TDisposableObject.__MarkDestroying(const Obj);
var
  LRef: Integer;
begin
  repeat
    LRef := TDisposableObject(Obj).FRefCount;
  until AtomicCmpExchange(TDisposableObject(Obj).FRefCount, LRef or objDestroyingFlag, LRef) = LRef;
end;

procedure TDisposableObject.AfterConstruction;
begin
  AtomicDecrement(FRefCount);
end;

procedure TDisposableObject.BeforeDestruction;
begin
  if RefCount <> 0 then
    Error(reInvalidPtr);
end;

procedure TDisposableObject.Dispose;
begin
end;

class function TDisposableObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TDisposableObject(Result).FRefCount := 1;
end;

{$ENDIF AUTOREFCOUNT}

function TDisposableObject.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

function TDisposableObject._AddRef: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  Result := AtomicIncrement(FRefCount);
{$ELSE}
  Result := __ObjAddRef;
{$ENDIF}
end;

function TDisposableObject._Release: Integer;
begin
{$IFNDEF AUTOREFCOUNT}
  Result := AtomicDecrement(FRefCount);
  if Result = 0 then
  begin
    Dispose;
    __MarkDestroying(Self);
    Destroy;
  end;
{$ELSE}
  Result := __ObjRelease;
{$ENDIF}
end;


end.

Der Sinn und die Implementierung von DisposeAndNil liegt darin, dass damit nil Sicherheit gewährleistet und Rekursivität verhindert wird.

Das ganze IFDEF Zeugs liegt daran, dass ich einfach stumpf TInterfacedObject aus System kopiert habe, weil ich nicht davon ableiten wollte/konnte,
da ich eine zusätzliche Zeile in _Release hinzugefügt habe (Dispose aufrufen vorm Destroy). In das Destroy wollt ich es nicht hinzufügen,
weil man dann möglicherweise rekursive Dispose Aufrufe während eines Destroy Vorgangs hätte und dann diese auch noch gegen eventuelle Aktionen im Destroy
absichern hätte müssen (z.B. Überprüfung auf nil von fList in TD).

Das führt zu implementierungen von Dispose in z.B. TA wie folgt:

Delphi-Quellcode:

procedure TA.Dispose;
begin
  inherited;
  DisposeAndNil(fB);
  DisposeAndNil(fC);
end;

Wichtig: Das ganze hat trotz Namensähnlichkeit nix mit TObject.DisposeOf zu tun. Das ist nämlich a) nicht überschreibbar b) macht auf nicht ARC nix anderes als Free aufzurufen und am wichtigsten c) ruft auf ARC nur den Destructor auf aber gibt den Speicher nicht frei. Die zurückgelassene Instanz ist dann ein Zombie, denn es wird nicht CleanupInstance aufgerufen so dass gemanagte nicht explizit auf leer/nil gesetzte Felder noch gesetzt sind (siehe RSP-14682).