Strange AV podczas przechowywania odwołanie Delphi interfejsu

Question

Otrzymuję nieoczekiwany błąd naruszenia zasad dostępu w poniższym kodzie:

program Project65; 

{$APPTYPE CONSOLE} 

{$R *.res} 

uses 
    SysUtils; 

type 
    ITest = interface 
    end; 

    TTest = class(TInterfacedObject, ITest) 
    end; 

var 
    p: ^ITest; 

begin 
    GetMem(p, SizeOf(ITest)); 
    p^ := TTest.Create; // AV here 
    try 
    finally 
    p^ := nil; 
    FreeMem(p); 
    end; 
end. 

wiem, że interfejsy powinny być wykorzystywane w różny sposób. Pracuję jednak nad dotychczasową bazą kodową, która wykorzystuje to podejście. Byłem bardzo zaskoczony widząc, że nie wystarczy zarezerwować pamięć SizeOf (ITest), aby umieścić tam ITest.

Teraz ciekawie gdybym zmienić pierwszą linię do

GetMem(p, 21); 

niż AV nie ma. (20 bajtów lub mniej nie powiedzie się). Jakie jest tego wytłumaczenie?

(używam Delphi XE2 Aktualizacja 4 + poprawką)

Proszę nie komentować, jak straszne jest kod lub sugerować, jak to może być odpowiednio kodowane. Zamiast tego proszę odpowiedzieć, dlaczego konieczne jest zarezerwowanie 21 bajtów zamiast SizeOf (ITest) = 4?

Answer 1

Co masz napisane skutecznie robi następującą logikę kulisami:

var 
    p: ^ITest; 
begin 
    GetMem(p, SizeOf(ITest)); 
    if p^ <> nil then p^._Release; // <-- AV here 
    PInteger(p)^ := ITest(TTest.Create); 
    p^._AddRef; 
    ... 
    if p^ <> nil then p^._Release; 
    PInteger(p)^ := 0; 
    FreeMem(p); 
end; 

GetMem() nie jest gwarantowana do zera, co to przydziela. Kiedy przypisujesz nową instancję obiektu do interfejsu varaiable, jeśli bajty nie są zerami, RTL pomyśli, że jest już istniejące odniesienie do interfejsu i spróbuje wywołać jego metodę _Release(), powodując AV, ponieważ nie jest on wspierany przez rzeczywisty instancja obiektu. Trzeba wyzerować przydzielonych bajtów wcześniej, wówczas RTL będzie zobaczyć odniesienie nil interfejsu i nie starają się wywołać jego metodę _Release() już:

program Project65; 

{$APPTYPE CONSOLE} 

{$R *.res} 

uses 
    SysUtils; 

type 
    ITest = interface 
    end; 

    TTest = class(TInterfacedObject, ITest) 
    end; 

var    
    p: ^ITest;    

begin    
    GetMem(p, SizeOf(ITest));    
    try 
    FillChar(p^, SizeOf(ITest), #0); // <-- add this! 
    p^ := TTest.Create; // <-- no more AV 
    try 
     ... 
    finally 
     p^ := nil; 
    end; 
    finally 
    FreeMem(p); 
    end; 
end.