Strange memory overwrite problem in instance of my class

This problem is related to this question, which I've asked earlier. The code provided by @RRUZ is working but it seems that not quite correctly or I am doing something wrong.

After executing GetSharedFiles strange thing is happening in instance of TMyObject. The field FMyEvent which was (and it should be) nil points to some random data.

What I've discovered just 5 minutes ago is that if I turn off the optimization in compiler options it works fine after rebuild. So maybe this is some compiler bug?

Here is a code snapshot (Delphi 2009 Windows 7 64 bit):

unit Unit17;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm17 = class(TForm)
    btnetst: TButton;
    procedure btnTestClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type
  TMyEvent = procedure(Sender: TObject) of object;

type
  TMyObject = class(TObject)
  private
    FMyEvent: TMyEvent;
    function GetSharedFiles: TStringList;
  public
    property OnEvent: TMyEvent read FMyEvent write FMyEvent;
    procedure DoSomething;
  end;

var
  Form17: TForm17;

implementation

uses
  ActiveDs_TLB,
  ActiveX;

function ADsGetObject(lpszPathName:WideString; const riid:TGUID; out ppObject):HRESULT; safecall; external 'activeds.dll';

{$R *.dfm}

procedure TForm17.btnTestClick(Sender: TObject);
var
  MyObject: TMyObject;
begin
  MyObject := TMyObject.Create;
  try
    MyObject.DoSomething;
  finally
    if Assigned(MyObject) then
      MyObject.Free;
  end;
end;

{ TMyObject }

procedure TMyObject.DoSomething;
var
  TmpList: TStringList;
begin
  try

    TmpList := GetSharedFiles; //something is overwritting the memory in object and puts random data to FMyEvent?
    if Assigned(FMyEvent) then
      ShowMessage('WTF'); //this should not be called, and if you comment out GetSharedFiles it won't.

  finally
    if Assigned(TmpList) then
      TmpList.Free;
  end;
end;


function TMyObject.GetSharedFiles: TStringList;
var
  FSO           : IADsFileServiceOperations;
  Resources     : IADsCollection;
  Resource      : OleVariant;
  pceltFetched  : Cardinal;
  oEnum         : IEnumvariant;
begin
  Result := TStringList.Create;
  //establish the connection to ADSI
  if ADsGetObject('WinNT://./lanmanserver', IADsFileServiceOperations, FSO) = S_OK then
  begin
    //get the resources interface
    Resources := FSO.Resources;
    //get the enumerator
    oEnum:= IUnknown(Resources._NewEnum) as IEnumVariant;
    while oEnum.Next(1, Resource, pceltFetched) = 0 do
    begin
      Result.Add(LowerCase(Format('%s%s%s',[Resource.Path,#9,Resource.User])));
  开发者_StackOverflow中文版    Resource:=Unassigned;
    end;
  end;
end;    
end.

Any ideas what is going wrong? Thanks for your time.

The calling convention on this should probably be stdcall, not safecall:

function ADsGetObject(lpszPathName:WideString; const riid:TGUID; out ppObject):HRESULT; safecall; external 'activeds.dll';

Recap

Typical COM functions return a HRESULT result; They use it to pass an error code or S_OK if everything went fine. Using this type of function, you'd usually have this kind of code:

if CallComFunction(parameters) = S_OK then
  begin
    // Normal processing goes here
  end
else
  begin
    // Error condition needs to be dealt with here.
  end

Since error conditions can't usually be dealt with, Delphi provides us with the safecall pseudo-calling-convention. It's not a true calling convention because in fact it uses stdcall behind the scenes. What it does is to automatically generate the test for S_OK and, on failure, raises an error. So the typical COM method can be declared as either one of this:

function TypicalComFunction(Parameters): HRESULT; stdcall;
procedure TypicalComFunction(Parameters); safecall;

If you don't intend to deal with any potential errors use the second form (with safecall) and simply ignore the potential exception. If an error does occur, Delphi will raise an Exception, and that exception will bubble-up until it reaches a point in the application that can deal with the error. Or it bubbles up until it reaches Application's exception handler, and that's used to display the error for the user.

Using safecall, the typical code above looks like this:

TypicalComFunction(Parameters); // raises exception on error    
// Normal processing goes here

On the other hand if you do need the HRESUL even if it's different from S_OK, then use the stdcall variant.

No, this does not mean a compiler bug per se. Changing compiler (Delphi<->FPC), compiler version or optimization options can affect codegeneration, and optimize away reference counted temps or free them earlier, or alter used registers and register allocation.

This in turn can make real hidden bugs pop up and off.

An example of such problem is that you call external functions. If for some reason their prototype (declaration in the relevant unit) is wrong, registers can get mutilated, and again varying of compiler options can cause heisenbug behaviour.

Also refcounting problems with automated types, or modifying global variables that are passed via CONST somewhere can cause such problems. There is a huge thread about the latter problem on the main FPC maillist atm.

Remember: code that has been working for a long time is not necessarily correct.

This is not going to be a compiler bug. Set a data breakpoint on the field and you'll find the code that is overwriting the field.

I had a similar bug in the past. It appeared ONLY when the compiler optimization was on. Otherwise, the code worked for about 2 years without problems. This is because the code compiled with optimization ON is very different than the code compiled with optimization OFF!!!!!!! The bug can manifest (or not) because of these chances.

Hints:

• Use FastMM (set on aggressive debugging mode)
• ALWAYS use FreeAndNil instead of Free. This may help you A LOT since it may force the bug in your code to appear sooner - maybe also in the code compiled with optimizations off. This will actually demonstrate that the bug was there all the time. You can do a massive 'search and replace' in your code for '.Free'.

These two tricks helped me to find the bug.