FreeAndNil - generowanie wyjątku

Cześć, to mój pierwszy post na tym forum jednak z 4p korzystam od paru lat. Podobnie ile piszę w Delphi.
Dziś jednak zostałem nieco zaskoczony sytuacją, w której proszę o pomoc:
mam w aplikacji klasę dziedziczącą po TObject i fragment kodu:

var
objekt:TMojaKlasa;
begin
if a=2 then objekt := TMojaKlasa.Create();
...

czyli obiekt nie zawsze zostanie zainicjalizowany, w aplikacji jest to ok 50/50. W sekcji finally jednak zawsze do tej pory używałem:

FreeAndNil(objekt)

bez sprawdzania przez Assigned czy został utworzony. Jakież było moje zdziwienie gdy dziś po release aplikacji nagle zaczęła generować wyjątki Access Volation w przypadku kiedy obiekt jest = nil. O ile się nie mylę przecież FreeAndNil powinien przed tym chronić?
Szczerze powiedziawszy sam już nie wiem co gdzie pozmieniałem, tej metody akurat nie ruszałem wcale. Pobrałem z SVN'a poprzednią rewizję, metody się pokrywają w 100%, dane testowe są identyczne i tam przy objekt = nil FreeAndNil nie generuje wyjątku. Oczywiście pewnym rozwiązaniem byłoby zastosowanie wyżej wspomnianego Assigned ale nie wiem czy chcę modyfikować prawie pół tysiąca wystąpień zwolnienia obiektu. Poza tym sam fakt nie daje mi spokoju co mogło się stać.

Będę wdzięczny za pomoc :)

Jeżeli nie inicjujesz na początku procedury tego objekt na nil (btw: obiekt przez i ;P), ma ono nieokreśloną wartość - może być nil, lecz równie dobrze może to być śmierć z poprzedniego wywołania, a tak wynika z podanego przez Ciebie fragmentu.

Z rozpędu zahaczyłem o polski i zamiast TObject wyszedł TObjekt :D To piszesz może mieć sens, spróbuję w pn ustawić na początku obiekt := nil i zobaczymy co z tego wyjdzie. Bardziej jednak interesu mnie dlaczego wersja poprzednia działa ok, a po release nowa się wysypuje bez ingerencji w kod owej metody.

tomix napisał(a)

Oczywiście pewnym rozwiązaniem byłoby zastosowanie wyżej wspomnianego Assigned ale nie wiem czy chcę modyfikować prawie pół tysiąca wystąpień zwolnienia obiektu.

Ty chyba nie piszesz poważnie... Jak można jeden obiekt tworzyć w jednym miejscu, a ponad pięciuset różnych go zwalniać..?!

Tak jak pisze @Patryk27 - w konstruktorze inicjuj na Nil, potem sprawdzaj przez Assigned czy istnieje i jeśli tak to zwalniaj przez FreeAndNil - wtedy może unikniesz takich niespodzianek.

Źle mnie zrozumiałeś Furious, chodziło mi to, że przyjąłem ogólnie taktykę stosowania FreeAndNil bez sprawdzania przez Assigned, bądź tworzenia bez przypisania nil na początku. Obiekt zawsze niszczę tam, gdzie to stworzyłem, a tworzę je praktycznie w każdej metodzie.
Dzięki za pomoc, wygląda na to, że będę musiał wprowadzić parę modyfikacji.

Kto i kiedy powiedział Ci, że FreeAndNil sprawdza czy obiekt <> nil??? FreeAndNil tym się różni od Free, że dodatkowo ustawia obiektowi wartość nil

procedure FreeAndNil(var Obj);
{$IF not Defined(AUTOREFCOUNT)}
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;
{$ELSE}
begin
  TObject(Obj) := nil;
end;
{$ENDIF}

Kto i kiedy powiedział Ci, że FreeAndNil sprawdza czy obiekt <> nil???

FreeAndNil tego nie robi, robi to Free... I zwalnia jeżeli nie jest równe nil, ale jako że jest to porządny kod to używa assigned.
Ale przecież skoro Free to sprawdza, to zapewne reszta funkcji FreeAndNil jest niebezpieczna przy nil że o tym wspominasz? A może po prostu źle zrozumiałeś uproszczenie i czepiasz się poprawnego uproszczenia, bo FreeAndNil jest bezpieczne przy obiekcie równym nil.

procedure FreeAndNil(var Obj);
{$IF not Defined(AUTOREFCOUNT)}
var
Temp: TObject;
begin
Temp := TObject(Obj);
Pointer(Obj) := nil;
Temp.Free;
end;
{$ELSE}
begin
TObject(Obj) := nil;
end;
{$ENDIF}

Nie wiem skąd masz taką deklarację z automatycznie zwalniającymi się klasami, ale pierwszy blok można zrzutować bez użycia zmiennej temp... No chyba że przypisanie nila jest istotne przed zwalnianiem, co raczej nie powinno mieć miejsca jako że klasy nie są refcountowane... No ale chętnie dowiem się skąd ta deklaracja i może dlaczemu?

i tam przy objekt = nil FreeAndNil nie generuje wyjątku

Bo na stacku masz tam akurat 0, zapewne dlatego że jest to najwyższa ramka stosu w całym programie lub poprzednie ramki ustawiły tam 0.

ze źródeł Delphi? To akurat z XE3, w D7 było tylko to co jest w {IF not ... bez tego w {#ELSE}. Po co jest Temp nie mnie oceniać - mądrzejsi ode mnie to pisali

@abrakadaber:

Metoda FreeAndNil prezentuje się tak (Delphi 7):

procedure FreeAndNil(var Obj);
var
  Temp: TObject;
begin
  Temp := TObject(Obj);
  Pointer(Obj) := nil;
  Temp.Free;
end;

Z kolei metoda Free w taki sposób:

procedure TObject.Free;
begin
  if Self <> nil then
    Destroy;
end;

+http://www.delphibasics.co.uk/RTL.asp?Name=FreeAndNil

Ktoś ma jeszcze jakieś wątpliwości? ;P

Metoda FreeAndNil jest odporna na już istniejącego nila, czyli coś takiego:

var obiekt:TObiekt = nil;
...
FreeAndNil(obiekt);

się nie wywali.

Natomiast metoda ta NIE jest odporna na śmieciową, niezainicjalizowaną wartość wskaźnika.

var obiekt:TObiekt; // śmieci
...
FreeAndNil(obiekt); // BUM!

No ale chętnie dowiem się skąd ta deklaracja i może dlaczemu?

Free Pascal definiuje procedurę tak samo: najpierw nil a dopiero potem Free na zmiennej tymczasowej:

procedure FreeAndNil(var obj);
  var
    temp: tobject;
  begin
    temp:=tobject(obj);
    pointer(obj):=nil;
    temp.free;
  end;

Uznajmy więc, że kryje się za tym jakiś wyższy cel :-)

Dziękuję Panowie za odpowiedzi, teraz już wiem w których miejscach popełniłem błędy. Nie wiem dlaczego, ale wychodziłem z dwóch fałszywych założeń: zadeklarowany obiekt na początku = nil, FreeAndNil jest zawsze bezpieczne.
Człowiek na błędach się uczy :)

Tak na siłę, to można by napisać wersję FreeAndNil, która sprawdza, czy przekazany wskaźnik rzeczywiście jest obiektem (bodajże pakiet JEDI posiada funkcję, która to potrafi sprawdzić, lecz równie dobrze wystarczyłoby po pierwsze sprawdzić, czy w ogóle dany obszar pamięci jest zaalokowany, a po drugie pobawić się z VMT - afair w nim znajduje się na pewnej pozycji wskaźnik na samego siebie), lecz byłoby to strasznie powolne i bezcelowe :P

Kolejny kod z serii nie rób tego w domu udowadniający mój post powyżej:

{$APPTYPE CONSOLE}
Uses Windows;

Type PVmt = ^TVmt;
     TVmt = Packed Record // struktura virtual-method-table (VMT)
             SelfPtr           : TClass;
             IntfTable         : Pointer;
             AutoTable         : Pointer;
             InitTable         : Pointer;
             TypeInfo          : Pointer;
             FieldTable        : Pointer;
             MethodTable       : Pointer;
             DynamicTable      : Pointer;
             ClassName         : PShortString;
             InstanceSize      : PLongint;
             Parent            : ^TClass;
             SafeCallException : Pointer;
             AfterConstruction : Pointer;
             BeforeDestruction : Pointer;
             Dispatch          : Pointer;
             DefaultHandler    : Pointer;
             NewInstance       : Pointer;
             FreeInstance      : Pointer;
             Destroy           : Pointer;
            End;

Function GetVmt(Instance: TObject): PVmt; // pobiera adres VMT przekazanej instancji obiektu
Begin
 Result := PVmt(Instance.ClassType);
 Dec(Result);
End;

Function isObject(const Pnt: Pointer): Boolean; // sprawdza, czy przekazany adres wskazuje na obiekt
Var VMT: PVMT;
Begin
 Result := False;

 if (not isBadCodePtr(Pnt)) Then // jeżeli adres wskazuje na jakikolwiek zaalokowany blok pamięci...
 Begin
  VMT := GetVMT(TObject(Pnt)); // pobierz VMT

  if (not isBadCodePtr(@VMT^.SelfPtr)) Then // jeżeli pole `SelfPtr` z VMT znajduje się wciąż w zaalokowanym bloku pamięci (patrz przykład ostatni poniżej)...
   Result := Int64(VMT^.SelfPtr) = (Int64(VMT) + sizeof(TVMT)); // sprawdź pole `SelfPtr`, czyli wskaźnik VMT na samego siebie
 End;
End;

Var Obj: TObject;
    Pnt: Pointer;
Begin
 Obj := TObject.Create;

 Writeln('isObject(nil)            -> ', isObject(nil)); // false
 Writeln('isObject(Pointer($1024)) -> ', isObject(Pointer($1024))); // false
 Writeln('isObject(Obj)            -> ', isObject(Obj)); // true

 Writeln;
 Writeln('Obj.Destroy()');
 Obj.Destroy;
 Writeln;

 Writeln('isObject(Obj)            -> ', isObject(Obj)); // false

 GetMem(Pnt, 10);
 Writeln('isObject(Pnt)            -> ', isObject(Pnt)); // false

 Readln;
End.

Sprawdzane pod Delphi 7 na 64-bitowym Windows 8 - u mnie zwraca wyniki takie, jak w komentarzach.
Z kolei kompilacja na FPC 2.6.2 powoduje dziwnego crasha w drugim przypadku... no ale cóż: do not try this at home!...
Enjoy! ;P

Uznajmy więc, że kryje się za tym jakiś wyższy cel

Nie wyższy cel, tylko zapewne chodzi o to że może być problem z obiektami które są refcountowane (interfejsy? nie mam pojęcia).
Co do deklaracji z XE3 to jest ona dziwna, bo wynika z tego że można robić refcountowane klasy (.NET? A może coś jeszcze innego?).

Tak na siłę, to można by napisać wersję FreeAndNil, która sprawdza, czy przekazany wskaźnik rzeczywiście jest obiektem (bodajże pakiet JEDI posiada funkcję, która to potrafi sprawdzić, lecz równie dobrze wystarczyłoby po pierwsze sprawdzić, czy w ogóle dany obszar pamięci jest zaalokowany, a po drugie pobawić się z VMT - afair w nim znajduje się na pewnej pozycji wskaźnik na samego siebie), lecz byłoby to strasznie powolne i bezcelowe

Kwestia tego jak dobrze te losowe dane będą udawały klasę. Z tego co wiem to kompilator nie robi niczego specjalnego żeby oznaczyć ten prawierekord jako klasę. I podpowiem ci coś - to się może skończyć tylko jeszcze gorzej niż self wskazujące na śmieci...

"a po drugie pobawić się z VMT - afair w nim znajduje się na pewnej pozycji wskaźnik na samego siebie" - bzdura. VMT jest jedno, a obiektów ze wskaźnikiem na to VMT wiele

Tak, masz rację. VMT to nie jest nic więcej niż tablica statyczna z pointerami na metody wirtualne. Przy czym RTTI itp. mogą mieszać.

nawet jak odczytasz VMT, to nie wiesz czy to jest prawidłowy obiekt, czy już zniszczony wywołaniem Destroy...

Po wykonaniu destroy wewnętrzne systemy przydziału nie widzą już tego obszaru jako zajęte. Co prawda VMT nadal może być poprawne ale chodzi raczej o samo pole VMT w obiekcie którego pamięć będzie oznaczona jako wolna.

  TVmt = Packed Record // struktura virtual-method-table (VMT)
             SelfPtr           : TClass;

Twój kod jest bez sensu dla VMT w FPC, poza tym packed nic nie zmienia jako że używasz samych 4bajtowych bloków.
W FPC VMT jest inne, nie ma wskaźnika na klasę-matkę gdyż VMT może być dzielone między klasami tego samego typu.

Nie mniej kod całkiem fajny, zapomniałem że można użyć isBadCodePtr. Teraz kwestia jak napisać prosty kod okłamujący twój kod o istnieniu takiej klasy...

ergerhrghr napisał(a):

  TVmt = Packed Record // struktura virtual-method-table (VMT)
             SelfPtr           : TClass;

Twój kod jest bez sensu dla VMT w FPC, poza tym packed nic nie zmienia jako że używasz samych 4bajtowych bloków.

"packed" dodałem z przyzwyczajenia ;P

Teraz kwestia jak napisać prosty kod okłamujący twój kod o istnieniu takiej klasy...

Bardzo łatwo:

Var FakeVMT, FakeObject: Pointer;
Begin
 GetMem(FakeVMT, -vmtSelfPtr); // alokujemy pamięć
 FakeVMT := Pointer(Longword(FakeVMT)-vmtSelfPtr); // przesuwamy ją o `-vmtSelfPtr` bajtów do przodu (`vmtSelfPtr` to w D7 wartość ujemna)
 PLongword(Longword(FakeVMT)+vmtSelfPtr)^ := Longword(FakeVMT); // ustawiamy odpowiednie pole (selfptr) na samego-siebie

 GetMem(FakeObject, 4); // tworzymy fałszywy obiekt
 PLongword(FakeObject)^ := Longword(FakeVMT); // jedyne czego potrzebujemy, to pierwsze 4 bajty będące w D7 adresem VMT. We FPC chyba również i na tym podobieństwa w tych dwóch kompilatorach się kończą ;P

 Writeln(isObject(FakeObject)); // true
End.

Cóż - idealnych rozwiązań nie ma :P

Function isObject(const Pnt: Pointer): Boolean;
Var VMT : Pointer;
SelfPtr: PPointer;
Begin
Result := False;

if (not isBadCodePtr(Pnt)) Then
Begin
VMT := Pointer(TObject(Pnt).ClassType);

SelfPtr := Pointer(Int64(VMT)+vmtSelfPtr);

if (not isBadCodePtr(SelfPtr)) Then
Result := (SelfPtr^ = VMT);
End;
End;

Var Obj: TObject;
Pnt: Pointer;
Begin
Obj := TObject.Create;

Writeln('isObject(nil) -> ', isObject(nil)); // false
Writeln('isObject(Pointer($1024)) -> ', isObject(Pointer($1024))); // false
Writeln('isObject(Obj) -> ', isObject(Obj)); // true

Writeln;
Writeln('Obj.Destroy()');
Obj.Destroy;
Writeln;

Writeln('isObject(Obj) -> ', isObject(Obj)); // false

GetMem(Pnt, 10);
Writeln('isObject(Pnt) -> ', isObject(Pnt)); // false

Readln;
End.

VMT := Pointer(TObject(Pnt).ClassType);

ClassType? Wcześniej odejmowałeś 4 bajty więc uznałem że brałeś po prostu dalsze pole (co było niepotrzebne) ale tutaj chyba jest źle. Skoro ma być offset +0, to powinno być Pointer(TObject(Pnt)), czyż nie?
Nic nie testowałem ani żadnym kodem nie potwierdzałem więc może być jakiś oczywisty błąd w moim myśleniu.

Cóż - idealnych rozwiązań nie ma

Powiedział twórca łamacza zasad programowania... :>

eyfgbdhj napisał(a):

VMT := Pointer(TObject(Pnt).ClassType);

ClassType? Wcześniej odejmowałeś 4 bajty więc uznałem że brałeś po prostu dalsze pole (co było niepotrzebne) ale tutaj chyba jest źle. Skoro ma być offset +0, to powinno być Pointer(TObject(Pnt)), czyż nie?

function TObject.ClassType: TClass;
begin
  Pointer(Result) := PPointer(Self)^;
end;