无效的指针操作——不知道为什么

Question

我一直在努力解决一个问题，并开发了一个示例应用程序来显示（或多或少 - 发生错误，但它在不同的位置）我一直遇到的问题。

此代码的想法是拥有一个对象 TGenericList，其中包含一个包含不同类型数据（例如 Integer、Double、Records 等）的通用对象列表。当其中一个对象发生变化时，它应该通知持有该对象的列表。

示例程序在运行时在该行给我一个 EInvalidPointer 异常

L.Free;

在应用程序结束时。

在调试器中跟踪时，在 TInterfacedObject 例程中引发异常：

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

我看到的是调用了 Destroy，然后调用了 System._BeforeDestruction()：

function _BeforeDestruction(const Instance: TObject; OuterMost: ShortInt): TObject;
// Must preserve DL on return!
asm //StackAlignSafe
       { ->  EAX  = pointer to instance }
       {      DL  = dealloc flag        }
       { <-  EAX  = pointer to instance }  //  Result := Instance;
        TEST    DL,DL
        JG      @@outerMost                //  if OuterMost > 0 then Exit;
        RET
@@outerMost:
{$IFDEF ALIGN_STACK}
        PUSH    ECX     // 4 byte adjustment, and ECX is convenient
{$ENDIF ALIGN_STACK}
        PUSH    EAX
        PUSH    EDX
        MOV     EDX,[EAX]                  //  Instance.BeforeDestruction;
        CALL    DWORD PTR [EDX] + VMTOFFSET TObject.BeforeDestruction
        POP     EDX
        POP     EAX
{$IFDEF ALIGN_STACK}
        POP     ECX     // 4 byte adjustment, and ECX is convenient
{$ENDIF ALIGN_STACK}
end;
{$ENDIF X86ASMRTL}

异常发生在调用 TObject.BeforeDestruction 时。

如果我删除该行

ABase.RegisterObserver(Self);

在 TGenericList.AddBase() 中，我没有得到异常。另请注意，我什至还没有实现更改通知方法，所以观察者列表从未真正使用过——它只是存在并保存对象引用。在这种情况下，一个。

我唯一能想到的是 TList 以某种方式释放了观察者，因此当我调用 L.Free 时，它​​已经被释放了。我不认为 TList 这样做。帮助文件说 TObjectList 确实如此。再说一次，它似乎永远不会到达释放列表的行，这将释放 TBase 对象。

我在编译时没有收到任何警告。

我正在运行 Delphi - Tokyo (10.2)，社区版。

program GenericTest;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils, System.Generics.Collections;

type
  IObserver = interface
    ['{DD9243B9-0722-486A-B4BF-0929AB5B6627}']
    procedure ObservableChanged(Sender : TObject);
  end;

  IObservable = interface
    ['{39EA6448-6636-40F4-B618-740B0BB28127}']
    procedure RegisterObserver(Observer : IObserver);
    procedure UnregisterObserver(Observer : IObserver);
  end;

  TBase = class(TInterfacedObject, IObservable)
  private
    FName : String;
    FObservers : TList<IObserver>;
  public
    constructor Create(AName : String);
    destructor Destroy; override;
    procedure RegisterObserver(Observer : IObserver);
    procedure UnregisterObserver(Observer : IObserver);
    property Name : String read FName;
  end;

  TGenericBase = TBase;

  TGenericBase<T> = class(TGenericBase)
  private
    FData : T;
  public
    constructor Create(AName : String);
    constructor CreateValue(AName : String; AValue : T);
    property Data : T read FData write FData;
  end;

  TGenericList = class(TInterfacedObject, IObserver)
  private
    FBases : TObjectDictionary<String, TBase>;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddBase(ABase : TBase);
    function GetBase<T: TBase>(AName : String) : T;
    procedure ObservableChanged(Sender : TObject);
  end;

//
// TBase
//
constructor TBase.Create(AName: string);
begin
  inherited Create;
  FObservers := TList<IObserver>.Create();
  FName := AName;
end;

destructor TBase.Destroy;
begin
  if (FObservers <> nil) then FObservers.Free;
end;

procedure TBase.RegisterObserver(Observer : IObserver);
begin
  if (FObservers <> nil) then FObservers.Add(Observer);
end;

procedure TBase.UnregisterObserver(Observer : IObserver);
begin
  if (FObservers <> nil) then FObservers.Remove(Observer);
end;

//
// TGenericBase<T>
//
constructor TGenericBase<T>.Create(AName : String);
begin
  inherited Create(AName);
  FData := Default(T);
end;

constructor TGenericBase<T>.CreateValue(AName : String; AValue : T);
begin
  inherited Create(AName);
  FData := AValue;
end;

//
// TGenericList
//
constructor TGenericList.Create;
begin
  inherited Create;
  FBases := TObjectDictionary<String, TBase>.Create([doOwnsValues], 32);
end;

destructor TGenericList.Destroy;
begin
  if (FBases <> nil) then FBases.Free;
  inherited Destroy;
end;

procedure TGenericList.AddBase(ABase : TBase);
begin
  FBases.Add(ABase.Name, ABase);
  // Comment out this line and the error doesn't occur.
  ABase.RegisterObserver(Self);
end;

function TGenericList.GetBase<T>(AName : String) : T;
var C : TBase;
begin
  if not FBases.TryGetValue(AName, C) then
    raise Exception.Create('Couldn''t get base.');

  Result := C as T;
end;

procedure TGenericList.ObservableChanged(Sender : TObject);
begin
  WriteLn((Sender as TGenericBase).Name);
end;

//
//
//
var C : TGenericBase;
    L : TGenericList;
    K : Integer;
    D : TGenericBase<Double>;
begin
  try
    L := TGenericList.Create;
    try
      for K := 0 to 10 do begin
        C := TGenericBase<Double>.CreateValue(IntToStr(K), K);
        L.AddBase(C);
      end;

      for K := 0 to 10 do begin
        D := L.GetBase<TGenericBase<Double>>(IntToStr(K));
        WriteLn(D.Data);
      end;

    finally
      L.Free;
    end;
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  ReadLn;
end.

Answer 1

如果你释放了L，并且L 也被用作接口引用，那么你就是在搞乱接口的引用计数系统。这会导致你的问题。

一般情况下：除非您真的知道自己在做什么，否则不要将对象和接口引用混合到同一个对象中。后者无法用简单的答案来解释。

简而言之：不要释放同时用作接口的对象。

接口的自动引用计数最终将释放它，当它不再被引用时。不要干涉那个。如果在引用计数不为 0 时释放项目，则会出现“无效指针操作”错误，正如您所发现的。

更多信息请参阅 Delphi 文档：Using Interfaces。该文档也可以在帮助文件中找到。