Invalid Pointer Operation -- don't know why

Question

I have been struggling with a problem and developed a sample application that shows (more or less -- error happens, but it's at a different spot) the issue I've been having.

The idea of this code is to have an object TGenericList that contains a list of generic objects that hold different types of data (e.g. Integer, Double, Records, etc). When one of the objects changes, it should notify the list that is holding the object.

The sample program, when run, gives me an EInvalidPointer exception at the line

L.Free;

at the end of the application.

When tracing in the debugger the exception is raised in a TInterfacedObject routine:

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

What I see is that Destroy is called and then System._BeforeDestruction() is called:

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}

The exception occurs at the call to TObject.BeforeDestruction.

If I delete the line

ABase.RegisterObserver(Self);

in TGenericList.AddBase(), I don't get the exception. Also note that I haven't even implemented the change notification method so the list of observers is never really used -- it just exists and holds object references. In this case, one.

The only thing I can think of is that the TList is somehow freeing the observers and therefore when I call L.Free, it is already free'd. I didn't think TList does that. The help file says that TObjectList does. Then again, it never seems to get to the line where the list is free'd which would free the TBase objects.

I get no warnings when I compile.

I am running Delphi - Tokyo (10.2), Community Edition.

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

If you free L, and L is also in use as interface reference, you are messing with the reference count system for interfaces. This will cause your problem.

In general: Do not mix object and interface references to the same object unless you really really know what you are doing. The latter can't be explained in a simple answer.

In short: Do not free an object that is also used as interface.

The automatic reference count for interfaces will eventually free it, when it is not referenced anymore. Do not interfere with that. If the item is freed when the reference count is not 0, it will give you the 'Invalid pointer operation' error, as you found out.

More on this in the Delphi documentation: Using Interfaces. This documentation can also be found in the help files.