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

时间:2018-10-12 19:08:56

标签: delphi

我一直在努力解决问题,并开发了一个示例应用程序,该应用程序显示(或多或少-发生了错误,但在不同的地方)我遇到的问题。

此代码的想法是让对象TGenericList包含一个包含不同类型数据(例如Integer,Double,Record等)的通用对象列表。当其中一个对象发生更改时,它应该通知保存该对象的列表。

示例程序在运行时,在第

行给了我一个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.

1 个答案:

答案 0 :(得分:2)

如果您释放了L,并且L也被用作接口引用,则您将弄乱接口的引用计数系统。这将导致您的问题。

通常:除非您真的很清楚自己在做什么,否则不要将对象和接口引用混合到同一对象中。后者无法用简单的答案来解释。

简而言之:请勿释放也用作界面的对象

接口的自动引用计数最终将在不再被引用时释放它。不要干涉。如果您在引用计数不为0的情况下释放了该项,则会发现错误,提示您“无效指针操作”。

Delphi文档中的更多内容:Using Interfaces。该文档也可以在帮助文件中找到。