On 29/09/06, Vincent Snijders <[EMAIL PROTECTED]> wrote:
I thought in your initial mail your were talking about having a console test app with threads. Synchronize is harder then, because you have to call CheckSynchronize yourself.Vincent.
Below is a text (console) thread demo. The one thread counts from 0 to
1k and the other thread counts down from 1k to 0. Again, under Linux,
one thread executes and teminates, then the next thread executes and
terminates. Under windows, both threads run at the same time (output
is mixed as expected). No sychronize() is used in this demo. See
attached screenshots for my output.
Regards,
- Graeme -
---------------------------------------
program demo1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils;
type
// counts up till 1k
TIncrementer = class(TThread)
protected
procedure Execute; override;
end;
// counts down from 1k
TDecrementer = class(TThread)
protected
procedure Execute; override;
end;
TRunThreads = class(TObject)
procedure ThreadTerminated(Sender: TObject);
private
t1, t2: TThread;
FThreadCount: integer;
public
constructor Create;
procedure RunNow;
end;
{ TRunThreads }
procedure TRunThreads.ThreadTerminated(Sender: TObject);
begin
Dec(FThreadCount);
end;
constructor TRunThreads.Create;
begin
FThreadCount := 2;
t1 := TIncrementer.Create(True);
t1.OnTerminate := @ThreadTerminated;
t1.Priority := tpLower;
t1.FreeOnTerminate := True;
t2 := TDecrementer.Create(True);
t2.OnTerminate := @ThreadTerminated;
t2.Priority := tpLower;
t2.FreeOnTerminate := True;
end;
procedure TRunThreads.RunNow;
begin
writeln('RunNow');
t1.Resume;
t2.Resume;
repeat
sleep(100);
until FThreadCount = 0;
WriteLn('All threads completed!');
end;
{ TIncrementer }
procedure TIncrementer.Execute;
var
i: integer;
begin
for i := 0 to 1000 do
Writeln(Classname + ': ' + IntToStr(i));
Terminate;
end;
{ TDecrementer }
procedure TDecrementer.Execute;
var
i: integer;
begin
for i := 1000 downto 0 do
Writeln(Classname + ': ' + IntToStr(i));
Terminate;
end;
var
lRunThreads: TRunThreads;
begin
lRunThreads := TRunThreads.Create;
lRunThreads.RunNow;
writeln('Done...');
end.
---------------------------------------
--
There's no place like 127.0.0.1
linux_demo1.png
Description: PNG image
vmware_win32_demo1.png
Description: PNG image
_______________________________________________ fpc-pascal maillist - fpc-pascal@lists.freepascal.org http://lists.freepascal.org/mailman/listinfo/fpc-pascal
