mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-18 06:38:20 +02:00
c477df5046
tested on FreeBSD (general Unix) and Windows. Note that Haiku seems
to have a native threadmgr rather than the Unix one. Will notify
maintainer (Olivier)
git-svn-id: trunk@15026 -
47 lines
851 B
ObjectPascal
47 lines
851 B
ObjectPascal
program crittest;
|
|
// originally a test to test .tryenter.
|
|
// A thread holds a lock for 5sec, while the main thread tries to lock
|
|
// it.
|
|
|
|
{$mode Delphi}
|
|
|
|
Uses {$ifdef unix}cthreads,{$endif} syncobjs,sysutils,classes;
|
|
|
|
type TTestthread = class(tthread)
|
|
procedure execute; override;
|
|
end;
|
|
|
|
var crit : TCriticalSection;
|
|
|
|
procedure TTestThread.Execute;
|
|
|
|
begin
|
|
crit.acquire;
|
|
sleep(5000);
|
|
crit.release;
|
|
end;
|
|
|
|
|
|
var thr : TTestthread;
|
|
I : integer;
|
|
|
|
begin
|
|
crit:=TCriticalsection.create;
|
|
thr :=TTestthread.Create(false);
|
|
|
|
sleep(500); // give thread time to start.
|
|
|
|
writeln('tryenter');
|
|
|
|
i:=0;
|
|
while not(crit.tryenter) do
|
|
begin
|
|
writeln('tryenter attempt ',i);
|
|
inc(i);
|
|
sleep(100);
|
|
end;
|
|
writeln('lock acquired in mainthread!');
|
|
writeln('no payload, so releasing');
|
|
crit.release;
|
|
thr.waitfor;
|
|
end. |