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 ?
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.