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.
--
_______________________________________________
Lazarus mailing list
[email protected]
http://lists.lazarus.freepascal.org/mailman/listinfo/lazarus
