paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 17:29:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* tinterlockedmt test: Ensure all threads have started.

Browse Source 
git-svn-id: trunk@32156 -
This commit is contained in:
yury 2015-10-26 10:14:47 +00:00
parent 2cea723a0d
commit 05ecee1895
1 changed files with 59 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

76
tests/test/tinterlockedmt.pp
View File

@ -27,7 +27,10 @@ type
constructor Create(ACount: longint; AOp: TOperation; AOption: longint = 0); constructor Create(ACount: longint; AOp: TOperation; AOption: longint = 0);
end; end;
//{$define TEST_BROKEN_IMPLEMENTATION} //{$define TEST_BROKEN_IncDec}
//{$define TEST_BROKEN_Exchange}
//{$define TEST_BROKEN_ExchangeAdd}
//{$define TEST_BROKEN_CompareExchange}
const const
TotalThreadCount = 50; TotalThreadCount = 50;
@ -36,17 +39,17 @@ const
var var
Counter, Counter2, Counter3: longint; Counter, Counter2, Counter3: longint;
WorkingCount: longint; WorkingCount, FinishedCount: longint;
AbortThread: boolean; AbortThread: boolean;
LastCompareVal: longint; LastCompareVal: longint;
{$ifndef FPC} {$ifndef FPC}
{$ifndef TEST_BROKEN_IMPLEMENTATION} {$ifndef TEST_BROKEN_CompareExchange}
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;
begin begin
Result:=longint(Windows.InterlockedCompareExchange(pointer(Target), pointer(NewValue), pointer(Comperand))); Result:=longint(Windows.InterlockedCompareExchange(pointer(Target), pointer(NewValue), pointer(Comperand)));
end; end;
{$endif TEST_BROKEN_IMPLEMENTATION} {$endif TEST_BROKEN_CompareExchange}
procedure ThreadSwitch; procedure ThreadSwitch;
begin begin
@ -54,14 +57,44 @@ begin
end; end;
{$endif FPC} {$endif FPC}
{$ifdef TEST_BROKEN_IMPLEMENTATION} {$ifdef TEST_BROKEN_CompareExchange}
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;
begin begin
Result:=Target; Result:=Target;
if Result = Comperand then if Result = Comperand then
Target:=NewValue; Target:=NewValue;
end; end;
{$endif TEST_BROKEN_IMPLEMENTATION} {$endif TEST_BROKEN_CompareExchange}
{$ifdef TEST_BROKEN_IncDec}
function InterlockedIncrement(var Target: longint): longint;
begin
Result:=Target;
Inc(Target);
end;
function InterlockedDecrement(var Target: longint): longint;
begin
Result:=Target;
Dec(Target);
end;
{$endif TEST_BROKEN_IncDec}
{$ifdef TEST_BROKEN_Exchange}
function InterLockedExchange(var Target: longint; Source: longint): longint;
begin
Result:=Target;
Target:=Source;
end;
{$endif TEST_BROKEN_Exchange}
{$ifdef TEST_BROKEN_ExchangeAdd}
function InterLockedExchangeAdd(var Target: longint; Source: longint): longint;
begin
Result:=Target;
Inc(Target, Source);
end;
{$endif TEST_BROKEN_ExchangeAdd}
procedure CheckResult(check, expected, code: longint; const Msg: string); procedure CheckResult(check, expected, code: longint; const Msg: string);
begin begin
@ -170,12 +203,12 @@ begin
end; end;
end; end;
InterLockedDecrement(WorkingCount); InterLockedIncrement(FinishedCount);
end; end;
procedure Run; procedure Run;
var var
i, j, k, CmpCount: longint; i, j, k, CmpCount, ThreadCount: longint;
t: TDateTime; t: TDateTime;
workers: array[0..TotalThreadCount - 1] of TWorker; workers: array[0..TotalThreadCount - 1] of TWorker;
begin begin
@ -205,23 +238,32 @@ begin
Inc(j); Inc(j);
Inc(k); Inc(k);
until j + (j - i) > TotalThreadCount; until j + (j - i) > TotalThreadCount;
ThreadCount:=j;
LastCompareVal:=k; LastCompareVal:=k;
writeln('Created ',j ,' threads.'); writeln('Created ', ThreadCount ,' threads.');
writeln('Starting threads...'); writeln('Starting threads...');
t:=Now; t:=Now;
for i:=0 to j - 1 do begin for i:=0 to ThreadCount - 1 do begin
workers[i].Suspended:=False; workers[i].Suspended:=False;
if Now - t > 5/SecsPerDay then begin if Now - t > 30/SecsPerDay then begin
writeln('Threads start takes too long to complete.'); writeln('Threads start takes too long to complete.');
Halt(4); Halt(4);
end; end;
end; end;
writeln('Waiting for threads to complete...');
Sleep(10);
t:=Now; t:=Now;
while WorkingCount <> 0 do begin while WorkingCount <> ThreadCount do begin
if Now - t > 30/SecsPerDay then begin
writeln('Not all threads have started: ', ThreadCount - WorkingCount);
Halt(5);
end;
Sleep(10);
end;
writeln('Waiting for threads to complete...');
t:=Now;
while FinishedCount <> ThreadCount do begin
if Now - t > WaitTime/SecsPerDay then begin if Now - t > WaitTime/SecsPerDay then begin
if AbortThread then begin if AbortThread then begin
writeln('Unable to abort threads.'); writeln('Unable to abort threads.');
@ -229,7 +271,7 @@ begin
end end
else begin else begin
AbortThread:=True; AbortThread:=True;
writeln('Timeout has expired. Active threads left: ', WorkingCount); writeln('Timeout has expired. Active threads left: ', ThreadCount - FinishedCount);
t:=Now; t:=Now;
end; end;
end; end;
@ -245,9 +287,9 @@ begin
if t = 0 then if t = 0 then
t:=1/MSecsPerDay; t:=1/MSecsPerDay;
CheckResult(Counter, 0, 1, 'Counter error:'); CheckResult(Counter, 0, 20, 'Counter error:');
CheckResult(Counter2, (LastCompareVal - 2)*CmpCount, 4, 'Counter2 error:'); CheckResult(Counter2, (LastCompareVal - 2)*CmpCount, 21, 'Counter2 error:');
writeln('Test OK.'); writeln('Test OK.');
writeln('InterLockedCompareExchange: ', Round(Counter2/(t*SecsPerDay)), ' ops/sec.'); writeln('InterLockedCompareExchange: ', Round(Counter2/(t*SecsPerDay)), ' ops/sec.');