* Test for tinterlocked

packages/fcl-base/tests/testinterlocked.pp

@@ -0,0 +1,168 @@
+program TInterlocked_tests;
+
+{$mode Delphi}
+
+uses
+  SysUtils, SyncObjs, Classes;
+
+var
+  i32: Longint;
+  New32, Old32: Longint;
+  i64: Int64;
+  New64, Old64: Int64;
+  Changed: Boolean;
+  list1, list2, oldlist: TStringList;
+  d1, d2, dOld: Double;
+  s1, s2, sOld: Single;
+
+begin
+  writeln('start testing of TInterlocked methods');
+
+  {* test all kinds of Longint usage *}
+  i32 := 12;
+  New32 := TInterlocked.Increment(i32);
+  if New32 <> 13 then halt(1);
+  if i32 <> 13 then halt(2);
+
+  New32 := TInterlocked.Decrement(i32);
+  if New32 <> 12 then halt(3);
+  if i32 <> 12 then halt(4);
+
+  New32 := TInterlocked.Add(i32, 12);
+  if New32 <> 24 then halt(5);
+  if i32 <> 24 then halt(6);
+
+  Old32 := TInterlocked.CompareExchange(i32, 36, 24);
+  if Old32 <> 24 then halt(7);
+  if i32 <> 36 then halt(8);
+
+  Old32 := TInterlocked.CompareExchange(i32, 48, 36, Changed);
+  if Old32 <> 36 then halt(9);
+  if Changed <> True then halt(10);
+  if i32 <> 48 then halt(11);
+
+  Old32 := TInterlocked.CompareExchange(i32, 123, 96, Changed);
+  if Old32 <> 48 then halt(12);
+  if Changed <> False then halt(13);
+  if i32 <> 48 then halt(14);
+
+  Old32 := TInterlocked.Exchange(i32, 96);
+  if Old32 <> 48 then halt(15);
+  if i32 <> 96 then halt(15);
+
+  {* test all kinds of Int64 usage *}
+  i64 := 12;
+  New64 := TInterlocked.Increment(i64);
+  if New64 <> 13 then halt(20);
+  if i64 <> 13 then halt(21);
+
+  New64 := TInterlocked.Decrement(i64);
+  if New64 <> 12 then halt(22);
+  if i64 <> 12 then halt(23);
+
+  New64 := TInterlocked.Add(i64, 12);
+  if New64 <> 24 then halt(24);
+  if i64 <> 24 then halt(25);
+
+  Old64 := TInterlocked.CompareExchange(i64, 36, 24);
+  if Old64 <> 24 then halt(26);
+  if i64 <> 36 then halt(27);
+
+  Old64 := TInterlocked.Exchange(i64, 48);
+  if Old64 <> 36 then halt(28);
+  if i64 <> 48 then halt(29);
+
+  Old64 := TInterlocked.Read(i64);
+  if Old64 <> 48 then halt(30);
+  if i64 <> 48 then halt(31);
+
+  {* test all kinds of TObject and generic class usage *}
+  list1 := TStringList.Create;
+  list2 := TStringList.Create;
+  try
+    list1.Add('A');
+    list2.Add('B');
+    list2.Add('C');
+
+    { TObject }
+    oldlist := TStringList(TInterlocked.CompareExchange(TObject(list1), TObject(list2), TObject(list1)));
+    if list1 <> list2 then halt(32);
+    if oldlist.Count = list1.Count then halt(33);
+    if oldlist.Count = list2.Count then halt(34);
+
+    oldlist := TStringList(TInterlocked.Exchange(TObject(list1), TObject(oldlist)));
+    if oldlist <> list2 then halt(35);
+    if list1.Count <> 1 then halt(36);
+    if list2.Count <> 2 then halt(37);
+
+    { generic class }
+    oldlist := TInterlocked.CompareExchange<TStringList>(list1, list2, list1);
+    if list1 <> list2 then halt(38);
+    if oldlist.Count = list1.Count then halt(39);
+    if oldlist.Count = list2.Count then halt(40);
+
+    oldlist := TInterlocked.Exchange<TStringList>(list1, oldlist);
+    if oldlist <> list2 then halt(41);
+    if list1.Count <> 1 then halt(42);
+    if list2.Count <> 2 then halt(43);
+  finally
+    list1.Free;
+    list2.Free;
+  end;
+
+  writeln('tests passed so far');
+
+  {* test all kinds of Double usage *}
+  d1 := Double(3.14);
+  d2 := Double(6.28);
+  dOld := TInterlocked.CompareExchange(d1, d2, d1);
+  if dOld <> Double(3.14) then halt(44);
+  if d1 = Double(3.14) then halt(45);
+  if d1 <> d2 then halt(46);
+
+  d1 := dOld;
+  dOld := TInterlocked.Exchange(d1, d2);
+  if dOld <> Double(3.14) then halt(47);
+  if d1 <> Double(6.28) then halt(48);
+  if d1 <> d2 then halt(49);
+
+  dOld := TInterlocked.CompareExchange(d1, dOld, d2);
+  if dOld <> Double(6.28) then halt(50);
+  if d1 <> Double(3.14) then halt(51);
+  if d1 = d2 then halt(52);
+
+  {* test all kinds of Single usage *}
+  s1 := Single(3.14);
+  s2 := Single(6.28);
+  sOld := TInterlocked.CompareExchange(s1, s2, s1);
+  if sOld <> Single(3.14) then halt(53);
+  if s1 = Single(3.14) then halt(54);
+  if s1 <> s2 then halt(55);
+
+  sOld := TInterlocked.CompareExchange(s1, sOld, s2);
+  if sOld <> Single(6.28) then halt(56);
+  if s1 <> Single(3.14) then halt(57);
+  if s1 = s2 then halt(58);
+
+  sOld := TInterlocked.Exchange(s2, s1);
+  if sOld <> Single(6.28) then halt(59);
+  if s1 <> Single(3.14) then halt(60);
+  if s1 <> s2 then halt(61);
+
+  {* test BitTestAndClear usage *}
+{
+  // enable when implemented!
+  i32 := 96;
+  Changed := TInterlocked.BitTestAndClear(i32, 6);
+  if Changed <> True then halt(62);
+  if i32 <> 32 then halt(63);
+}
+  {* test BitTestAndSet usage *}
+{
+  // enable when implemented!
+  Changed := TInterlocked.BitTestAndSet(i32, 4);
+  if Changed <> False then halt(64);
+  if i32 <> 48 then halt(65);
+}
+  writeln('testing of TInterlocked methods ended');
+end.