diff --git a/.gitattributes b/.gitattributes index eed29b0e1e..bc0aac280d 100644 --- a/.gitattributes +++ b/.gitattributes @@ -12285,6 +12285,7 @@ tests/test/tinterface3.pp svneol=native#text/plain tests/test/tinterface4.pp svneol=native#text/plain tests/test/tinterface5.pp svneol=native#text/plain tests/test/tinterface6.pp svneol=native#text/plain +tests/test/tinterlockedmt.pp svneol=native#text/plain tests/test/tinterrupt.pp svneol=native#text/plain tests/test/tintfcdecl1.pp svneol=native#text/plain tests/test/tintfcdecl2.pp svneol=native#text/plain diff --git a/tests/test/tinterlockedmt.pp b/tests/test/tinterlockedmt.pp new file mode 100644 index 0000000000..f95152ed99 --- /dev/null +++ b/tests/test/tinterlockedmt.pp @@ -0,0 +1,216 @@ +{$ifdef FPC} + {$mode objfpc} +{$else} + {$apptype console} +{$endif} + +uses +{$ifndef FPC} + Windows, +{$endif FPC} +{$ifdef unix} + cthreads, +{$endif unix} + SysUtils, Classes; + +type + TOperation = (opAdd, opDec, opExchange, opExchangeAdd, opExchangeDec, opCompareExchange); + + TWorker = class(TThread) + private + FOp: TOperation; + FCount: longint; + FOption: longint; + protected + procedure Execute; override; + public + constructor Create(ACount: longint; AOp: TOperation; AOption: longint = 0); + end; + +const + TotalThreadCount = 100; + TestCount = 1000000; + WaitTime = 30; + +var + Counter, Counter2, Counter3: longint; + WorkingCount: longint; + AbortThread: boolean; + LastCompareVal: longint; + +{$ifndef FPC} +function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; +begin + Result:=longint(Windows.InterlockedCompareExchange(pointer(Target), pointer(NewValue), pointer(Comperand))); +end; +{$endif FPC} + +procedure CheckResult(check, expected, code: longint; const Msg: string); +begin + if check <> expected then begin + writeln(Msg, ' Result: ', check, '; Expected: ', expected); + Halt(code); + end; +end; + +constructor TWorker.Create(ACount: longint; AOp: TOperation; AOption: longint); +begin + FCount:=ACount; + FOp:=AOp; + FOption:=AOption; + inherited Create(True); + FreeOnTerminate:=True; +end; + +procedure TWorker.Execute; +var + i, j: longint; + t: TDateTime; +begin + InterLockedIncrement(WorkingCount); + Sleep(10); + + case FOp of + opAdd: + begin + for i:=1 to FCount do begin + InterLockedIncrement(Counter); + if AbortThread then + break; + end; + end; + opDec: + begin + for i:=1 to FCount do begin + InterLockedDecrement(Counter); + if AbortThread then + break; + end; + end; + opExchange: + begin + for i:=1 to FCount do begin + j:=InterLockedExchange(Counter, 10); + InterLockedExchangeAdd(Counter, j - 10); + if AbortThread then + break; + end; + end; + opExchangeAdd: + begin + for i:=1 to FCount do begin + InterLockedExchangeAdd(Counter, 3); + if AbortThread then + break; + end; + end; + opExchangeDec: + begin + for i:=1 to FCount do begin + InterLockedExchangeAdd(Counter, -3); + if AbortThread then + break; + end; + end; + opCompareExchange: + begin + for i:=1 to FCount do begin + t:=Now; + j:=0; + while InterLockedCompareExchange(Counter3, FOption + 1, FOption) <> FOption do begin + Inc(j); + if (j > 1000) and (Now - t >= 5/SecsPerDay) then begin + writeln('InterLockedCompareExchange seems to be broken.'); + Halt(10); + end; + Sleep(0); + end; + if FOption + 2 <> LastCompareVal then + InterLockedIncrement(Counter3) + else + InterLockedExchange(Counter3, 0); + InterLockedIncrement(Counter2); + if AbortThread then + break; + end; + end; + end; + + InterLockedDecrement(WorkingCount); +end; + +procedure Run; +var + i, j, k, CmpCount: longint; + t: TDateTime; + workers: array[0..TotalThreadCount - 1] of TWorker; +begin + Counter:=0; + Counter2:=0; + Counter3:=0; + CmpCount:=TestCount div 400; + writeln('Creating threads...'); + j:=0; + k:=0; + repeat + i:=j; + workers[j]:=TWorker.Create(TestCount, opAdd); + Inc(j); + workers[j]:=TWorker.Create(TestCount, opDec); + Inc(j); + workers[j]:=TWorker.Create(TestCount div 3, opExchange); + Inc(j); + workers[j]:=TWorker.Create(TestCount, opExchangeAdd); + Inc(j); + workers[j]:=TWorker.Create(TestCount, opExchangeDec); + Inc(j); + workers[j]:=TWorker.Create(CmpCount, opCompareExchange, k); + Inc(j); + Inc(k, 2); + until j + (j - i) > TotalThreadCount; + LastCompareVal:=k; + writeln('Created ',j ,' threads.'); + + writeln('Starting threads...'); + t:=Now; + for i:=0 to j - 1 do begin + workers[i].Suspended:=False; + if Now - t > 5/SecsPerDay then begin + writeln('Threads start takes too long to complete.'); + Halt(4); + end; + end; + + writeln('Waiting for threads to complete...'); + Sleep(10); + t:=Now; + while WorkingCount <> 0 do begin + if Now - t > WaitTime/SecsPerDay then begin + if AbortThread then begin + writeln('Unable to abort threads.'); + Halt(3); + end + else begin + AbortThread:=True; + writeln('Timeout has expired.'); + t:=Now; + end; + end; + Sleep(10); + end; + + if AbortThread then begin + writeln('The execution is too slow.'); + Halt(2); + end; + + CheckResult(Counter, 0, 1, 'Counter error:'); + + CheckResult(Counter2, (k div 2)*CmpCount, 4, 'Counter2 error:'); + + writeln('Test OK.'); +end; + +begin + Run; +end.