[Lazarus] Mutlithreaded Dll Callback crashes my Application

[Alexander Grau]

Sven Barth schrieb:
> Am 25.08.2010 16:12, schrieb Alexander Grau:
>> Sven Barth schrieb:
>>> I looked at your example program and I also looked into FPC's Thread
>>> implementation for Windows. You need to play around with the Heap a
>>> bit more to make things interesting:
>>>
>>> Modify someFunc like in the following and someObj.someMethod won't be
>>> executed any more,
>> Using exactly your modifications, all code ist executed correctly - the
>> line you indicated is correctly reached and executed. No exceptions 
>> at all.
>>
>> I'm using FPC 2.4.0 for all my tests - I'm assuming you are using 2.2.4
>> ? (If that is the case there must have been a fix for this to make this
>> bug gone away).
>>
>
> Yes, I'm using 2.2.4... shame on me for not testing with a current FPC 
> -.-
>
> Does it even work if you use threadvars? It should as the Heap uses 
> threadvars, but I want to be sure. (and now I'm also curious to know 
> why it works with 2.4.0 ^^)
I have modified the test - now it's using multiple external threads and 
that works fine too until the moment I enable any 'writeln'. Using 
threadvars or not doesn't make any difference. Using any writeln will 
make it crash. If not using writeln, the external threads can call FPC 
objects to increase some counters that are correctly displayed at the 
end of the program for each thread.




program project1;

{$APPTYPE CONSOLE}

{$mode objfpc}{$H+}


uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  { you can add units after this }
  windows;

{$R project1.res}

type
  TSomeClass = class
  public
    procedure someMethod(idx: integer);
  end;


const
  COUNT = 30;

var
  i: integer;
  threadid: DWORD;
  ThreadHandles: array[1..COUNT] of THandle; //Rückgabewert von CreateThread
  counters: array[1..COUNT] of integer;
  someObj: TSomeClass;




procedure TSomeClass.someMethod(idx: integer);
begin
  //writeln('TSomeClass.someMethod called');
  inc(counters[idx]);
end;


procedure someFunc(param: pointer); cdecl;
var
  t: tobject;
begin
  //WriteLn('External is called - ThreadID=', GetCurrentThreadId);
  //if assigned(param) then writeln('blub');
  //writeln('param=', param);

  t := TObject.Create;
  try
    //Writeln(t.ClassName); // <--- here we get a crash
  finally
    t.Free;
  end;

  someObj.someMethod(integer(param));
end;

function ExternalThread(param: Pointer): LongInt; stdcall;
begin
  someFunc(param);
  Result:=0;
end;



begin

  WriteLn('Main ThreadID=', GetCurrentThreadId);
  someObj:=TSomeClass.create;

  for i:=1 to COUNT do counters[i]:=0;

  WriteLn('Creating external threads');
  for i:=1 to COUNT do
  begin
    ThreadHandles[i]:=CreateThread(nil, 0, 
TFNThreadStartRoutine(@ExternalThread),
      pointer(i), 0, ThreadID);
    if ThreadHandles[i] = 0 then writeln('ERROR creating external thread');
  end;

  readln;

  WriteLn('Freeing external thread');
  for i:=1 to COUNT do
  begin
    if ThreadHandles[i]<>0 then CloseHandle(ThreadHandles[i]);
  end;

  someObj.free;

  for i:=1 to COUNT do
    writeln (counters[i]);
end.