delphifastmm

How to test whether a object is freed in Delphi


The two programs as shown below try to test whether a object is freed, using the techniques described here Bad reference to an object already freed .

The first program as shown below runs correctly if compiled under Delphi 7, but wrongly if compiled under Delphi XE and upper. That is to say, it outputs

 D7          DXE 
True        True
True        True 
True        False
True        True
False       True
False       False

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils;

function ValidateObj(Obj: TObject): Pointer;
// see { Virtual method table entries } in System.pas
begin
  Result := Obj;
  if Assigned(Result) then
    try
      if Pointer(PPointer(Obj)^) <> Pointer(Pointer(Cardinal(PPointer(Obj)^) + Cardinal(vmtSelfPtr))^) then
        // object not valid anymore
        Result := nil;
    except
      Result := nil;
    end;
end;

function ValidateObj2(Obj: TObject): Pointer;
type
  PPVmt = ^PVmt;
  PVmt = ^TVmt;
  TVmt = record
    SelfPtr : TClass;
    Other   : array[0..17] of pointer;
  end;
var
  Vmt: PVmt;
begin
  Result := Obj;
  if Assigned(Result) then
    try
      Vmt := PVmt(Obj.ClassType);
      Dec(Vmt);
      if Obj.ClassType <> Vmt.SelfPtr then
        Result := nil;
    except
      Result := nil;
    end;
end;

var
   Obj: TObject;
begin
  Obj := TObject.Create;
  Writeln(BoolToStr(Assigned(Obj), True));
  Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True));
  Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True));
  Obj.free;
  Writeln(BoolToStr(Assigned(Obj), True));
  Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True));
  Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True));
  Readln;
end.

The second program, explicitly using FastMM4, as shown below runs wrongly when compiled under Delphi 7 or XE and upper. That is to say, it outputs

Expected      D7    DXE
  False     False  False
  True      True   True
  True      True   True 
  True      True   False
  True      False  False
  True      True   True
  False     True   True
  False     True   False

program Project2;

{$APPTYPE CONSOLE}

uses
  FastMM4,
  SysUtils;

function ValidateObj(Obj: TObject): Pointer;
// see { Virtual method table entries } in System.pas
begin
  Result := Obj;
  if Assigned(Result) then
    try
      if Pointer(PPointer(Obj)^) <> Pointer(Pointer(Cardinal(PPointer(Obj)^) + Cardinal(vmtSelfPtr))^) then
        // object not valid anymore
        Result := nil;
    except
      Result := nil;
    end;
end;

function ValidateObj2(Obj: TObject): Pointer;
type
  PPVmt = ^PVmt;
  PVmt = ^TVmt;
  TVmt = record
    SelfPtr : TClass;
    Other   : array[0..17] of pointer;
  end;
var
  Vmt: PVmt;
begin
  Result := Obj;
  if Assigned(Result) then
    try
      Vmt := PVmt(Obj.ClassType);
      Dec(Vmt);
      if Obj.ClassType <> Vmt.SelfPtr then
        Result := nil;
    except
      Result := nil;
    end;
end;

var
   Obj: TObject;
begin
  Obj := TObject.Create;        
  Writeln(BoolToStr(Obj is FastMM4.TFreedObject, True));
  Writeln(BoolToStr(Assigned(Obj), True));
  Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True));
  Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True));
  Obj.free;                                
  Writeln(BoolToStr(Obj is FastMM4.TFreedObject, True));
  Writeln(BoolToStr(Assigned(Obj), True));
  Writeln(BoolToStr(Assigned(ValidateObj(Obj)), True));
  Writeln(BoolToStr(Assigned(ValidateObj2(Obj)), True));
  Readln;
end.

I am confused how the wrong behavior is caused, and wonder how to test whether a object is freed for Delphi 7 and Delphi XE and upper, especially when FastMM4 is used ?


Solution

  • In general, it is not possible to make a robust test that a pointer refers to an instance that has been freed or not. It is the job of the programmer to maintain control of the lifetime of your objects.