delphi – 编译器提示/警告当传递对象实例直接作为const接口参数

编辑：样本当然很简单,可以说明问题.但在现实生活中,它变得越来越复杂：如果创建和使用的代码远远不同(不同的单元,不同的类,不同的项目)会怎么样？如果由不同的人维护怎么办？如果一个非const参数变成一个const参数,而不是所有的调用代码都可以被检查(因为改变代码的人不能访问所有的调用代码)呢？

下面的代码崩溃,很难找到原因.

首先是日志：

1.Run begin

1.RunLeakCrash
 2.RunLeakCrash begin
     NewInstance 1
     AfterConstruction 0
   3.LeakCrash begin
     _AddRef 1
    4.Dump begin
    4.Dump Reference=10394576
    4.Dump end
     _Release 0
     _Release Destroy
     BeforeDestruction 0
   3.LeakCrash Reference got destroyed if it had a RefCount of 1 upon entry,so now it can be unsafe to access it
     _AddRef 1
    4.Dump begin
    4.Dump Reference=10394576
    4.Dump end
     _Release 0
     _Release Destroy
     BeforeDestruction 0
   3.LeakCrash end with exception

1.Run end
EInvalidPointer: Invalid pointer operation

然后代码过早释放实现接口的对象实例：

//{$define all}

program InterfaceConstParmetersAndPrematureFreeingProject;

{$APPTYPE CONSOLE}

uses
  SysUtils,Windows,MyInterfacedObjectUnit in '..srcMyInterfacedObjectUnit.pas';

procedure Dump(Reference: IInterface);
begin
  Writeln('    4.Dump begin');
  Writeln('    4.Dump Reference=',Integer(PChar(Reference)));
  Writeln('    4.Dump end');
end;

procedure LeakCrash(const Reference: IInterface);
begin
  Writeln('   3.LeakCrash begin');
  try
    Dump(Reference); // now we leak because the caller does not keep a reference to us
    Writeln('   3.LeakCrash Reference got destroyed if it had a RefCount of 1 upon entry,so now it can be unsafe to access it');
    Dump(Reference); // we might crash here
  except
    begin
      Writeln('   3.LeakCrash end with exception');
      raise;
    end;
  end;
  Writeln('   3.LeakCrash end');
end;

procedure RunLeakCrash;
begin
  Writeln(' 2.RunLeakCrash begin');
  LeakCrash(TMyInterfacedObject.Create());
  Writeln(' 2.RunLeakCrash end');
end;

procedure Run();
begin
  try
    Writeln('1.Run begin');

    Writeln('');
    Writeln('1.RunLeakCrash');
    RunLeakCrash();

  finally
    Writeln('');
    Writeln('1.Run end');
  end;
end;

begin
  try
    Run();
  except
    on E: Exception do
      Writeln(E.ClassName,': ',E.Message);
  end;
  Readln;
end.

EInvalidPointer将在第二次调用Dump(Reference);
原因是引用引用的引用计数已经为零,所以底层对象已经被破坏了.

有关编译器插入或省略的引用计数代码的几个注释：

>没有标记const的参数(如在过程Dump(参考：IInterface));)获取隐式try / finally块来执行引用计数.
>标记为const的参数(类似于过程LeakCrash(const Reference：IInterface);)没有任何引用计数代码
传递对象实例创建的结果(如LeakCrash(TMyInterfacedObject.Create());)不生成任何引用计数代码

所有上述编译器行为都是非常合乎逻辑的,但是它们可以导致一个EInvalidPointer.
EInvalidPointer仅在非常狭窄的使用模式中显示.
该模式很容易被编译器识别,但很难调试或找到原因,当你陷入它.
解决方法很简单：将TMyInterfacedObject.Create()的结果缓存在一个中间变量中,然后将其传递给LeakCrash().

编译器是否提示或警告您这种使用模式？

最后我用代码跟踪所有的_AddRef / _Release / etcetera调用：

unit MyInterfacedObjectUnit;

interface

type
  // Adpoted copy of TInterfacedObject for debugging
  TMyInterfacedObject = class(TObject,IInterface)
  protected
    FRefCount: Integer;
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
    class function NewInstance: TObject; override;
    property RefCount: Integer read FRefCount;
  end;

implementation

uses
  Windows;

procedure TMyInterfacedObject.AfterConstruction;
begin
  InterlockedDecrement(FRefCount);
  Writeln('     AfterConstruction ',FRefCount);
end;

procedure TMyInterfacedObject.BeforeDestruction;
begin
  Writeln('     BeforeDestruction ',FRefCount);
  if RefCount <> 0 then
    System.Error(reInvalidPtr);
end;

class function TMyInterfacedObject.NewInstance: TObject;
begin
  Result := inherited NewInstance;
  TMyInterfacedObject(Result).FRefCount := 1;
  Writeln('     NewInstance ',TMyInterfacedObject(Result).FRefCount);
end;

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

function TMyInterfacedObject._AddRef: Integer;
begin
  Result := InterlockedIncrement(FRefCount);
  Writeln('     _AddRef ',FRefCount);
end;

function TMyInterfacedObject._Release: Integer;
begin
  Result := InterlockedDecrement(FRefCount);
  Writeln('     _Release ',FRefCount);
  if Result = 0 then
  begin
    Writeln('     _Release Destroy');
    Destroy;
  end;
end;

end.

–jeroen