[Lazarus] Mutlithreaded Dll Callback crashes my Application

[Alexander Grau]

Sven Barth schrieb:
> Am 25.08.2010 17:02, schrieb Alexander Grau:
>>> 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.
>
> So the runtime must be tested more when using external threads... Does 
> the writeln work when you use FPC threads?
Yes, using FPC threads it works - it crashes only when using external 
threads.

Here's my latest and finest test code for both cases:



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
  USE_EXT_THREADS = true;
  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;
  FPCthreads: array[1..COUNT] of tthread;


type
  TFPCThread = class(TThread)
  protected
    param: pointer;
    ffinished: boolean;
    procedure Execute; override;
  public
    constructor Create(aparam: pointer; CreateSuspended: boolean);
    property finished: boolean read ffinished;
  end;


  constructor TFPCThread.Create(aparam: pointer; CreateSuspended: boolean);
  begin
    param:=aparam;
    ffinished:=false;
    FreeOnTerminate := false;
    inherited create(CreateSuspended);
  end;

  procedure TFPCThread.execute;
  var
    t: tobject;
  begin
    t := TObject.Create;
    try
      Writeln(t.ClassName); // <--- here we get *NO* crash
    finally
      t.Free;
    end;
    someObj.someMethod(integer(param));
    ffinished:=true;
  end;

// ----------------------------------------------


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
    if USE_EXT_THREADS then
    begin
      ThreadHandles[i]:=CreateThread(nil, 0, 
TFNThreadStartRoutine(@ExternalThread),
        pointer(i), 0, ThreadID);
      if ThreadHandles[i] = 0 then writeln('ERROR creating external 
thread');
    end else FPCThreads[i]:=TFPCThread.Create(pointer(i), false);
  end;

  readln;

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

  someObj.free;

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