Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Strange AV when storing an Delphi interface reference

I am getting an unexpected Access Violation error in the following code:

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.

I know that interfaces should be used differently. However I am working on a legacy codebase which uses this approach. And I was very surprised to see that it is not sufficient to reserve SizeOf(ITest) memory to put an ITest there.

Now interestingly if I change the first line to

GetMem(p, 21);

than the AV is gone. (20 bytes or less fails). What is the explanation to this?

(I am using Delphi XE2 Update 4 + HotFix)

Please don't comment on how horrible the code is or suggest how this could be coded properly. Instead please answer why is it necessary to reserve 21 bytes instead of SizeOf(ITest) = 4?

like image 605
RM. Avatar asked Jun 11 '12 23:06

RM.


1 Answers

What you have effectively written is doing the following logic behind the scenes:

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() is not guaranteed to zero out what it allocates. When you assign the new object instance to the interface varaiable, if the bytes are not zeros, the RTL will think there is already an existing interface reference and will try to call its _Release() method, causing the AV since it is not backed by a real object instance. You need to zero out the allocated bytes beforehand, then the RTL will see a nil interface reference and not try to call its _Release() method anymore:

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.
like image 92
Remy Lebeau Avatar answered Oct 24 '22 08:10

Remy Lebeau