Как проверить, освобожден ли объект в Delphi

Question

Две программы, как показано ниже, пытаются проверить, освобожден ли объект, используя методы, описанные здесь Bad reference to an object already freed.

Первая программа, как показано ниже, работает правильно, если она скомпилирована под Delphi 7, но ошибочно, если она скомпилирована под Delphi XE и выше. То есть, он выводит

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. 

Второй программу, явным образом с помощью FastMM4, как показано ниже работает неправильно при компиляции под Delphi 7 или XE и верхним. То есть, он выводит

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. 

Я смущен, как вызвано неправильное поведение, и интересно, как проверить, является ли освобожден объектом для Delphi 7 и Delphi XE и верхнего, особенно когда FastMM4 используются?

Answer 1

В общем случае невозможно сделать надежный тест, который указатель ссылается на экземпляр, который был освобожден или нет. Задача программиста - следить за временем жизни ваших объектов.

Answer 2

Невозможно проверить, действителен ли объект, но сравнить его указатель на NIL. Запретить объекты иметь более один указатель, иначе, если этот объект освобожден одним указателем, ссылка на тот же объект на втором указателе вызовет нарушение прав доступа.