View Issue Details

IDProjectCategoryView StatusLast Update
0037089FPCRTLpublic2020-05-25 01:23
ReporterNoName Assigned To 
PrioritynormalSeverityminorReproducibilityalways
Status newResolutionopen 
Product Version3.3.1 
Summary0037089: Add TInterlocked class from Delphi
DescriptionNeeded for Delphi and easier/cleaner than using InterLockedIncrement/InterlockedCompareExchange/etc functions.

http://docwiki.embarcadero.com/Libraries/Rio/en/System.SyncObjs.TInterlocked
TagsNo tags attached.
Fixed in Revision
FPCOldBugId
FPCTarget
Attached Files

Activities

Bi0T1N

2020-05-20 18:10

reporter   ~0122957

Last edited: 2020-05-20 18:11

View 2 revisions

I've implemented most of it, just struggle with the Double/Single variant (no underlying function available for these types) and both BitTest* variants as my current code for them isn't atomic.


e.g. BitTestAndClear:
  // get actual value
  OldValue := InterlockedCompareExchange(Target, 0, 0);
  // bit set?
  Result := OldValue.TestBit(BitOffset);
  ChangedValue := OldValue.ClearBit(BitOffset);
  // write new value with bit set to zero if value is still the same in target
  InterlockedCompareExchange(Target, ChangedValue, OldValue);


Thaddy de Koning

2020-05-20 18:24

reporter   ~0122959

Last edited: 2020-05-20 18:25

View 2 revisions

Can you show the code? You can cast it to the bitpattern and on many cpu's the operations is already atomic (arm, intel) for most integer types, signed or not..

Bi0T1N

2020-05-20 20:54

reporter   ~0122963

The code above is from my function. The Double/Single exchange isn't implemented as I'd need to compare the values behind it - not just the memory addresses as you can do for objects.
Also attached my set of tests.
TInterlocked_tests.pas (4,743 bytes)   
program TInterlocked_tests;

{$mode Delphi}

uses
  SysUtils, SyncObjs, Classes;

var
  i32: Integer;
  New32, Old32: Integer;
  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 integer 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 *}
  i32 := 96;
  Changed := TInterlocked.BitTestAndClear(i32, 6);
  if Changed <> True then halt(62);
  if i32 <> 32 then halt(63);

  {* test BitTestAndSet usage *}
  Changed := TInterlocked.BitTestAndSet(i32, 4);
  if Changed <> False then halt(64);
  if i32 <> 48 then halt(65);

  writeln('testing of TInterlocked methods ended');
  readln;
end.
TInterlocked_tests.pas (4,743 bytes)   
01-Add_TInterlocked_without_Single_Double_BitTest.patch (8,366 bytes)   
diff --git packages/fcl-base/src/syncobjs.pp packages/fcl-base/src/syncobjs.pp
index 84c0adebd4..062c5116bb 100644
--- packages/fcl-base/src/syncobjs.pp
+++ packages/fcl-base/src/syncobjs.pp
@@ -81,6 +81,38 @@ type
       constructor Create;
    end;
 
+  TIntegerBitOffset = 0..31;
+  TInterlocked = class sealed
+    class function Add(var Target: Integer; Increment: Integer): Integer; overload; static; inline;
+    class function Add(var Target: Int64; Increment: Int64): Int64; overload; static; inline;
+    class function BitTestAndClear(var Target: Integer; BitOffset: TIntegerBitOffset): Boolean; static;
+    class function BitTestAndSet(var Target: Integer; BitOffset: TIntegerBitOffset): Boolean; static;
+    class function CompareExchange(var Target: Pointer; Value: Pointer; Comparand: Pointer): Pointer; overload; static; inline;
+    class function CompareExchange(var Target: Integer; Value: Integer; Comparand: Integer): Integer; overload; static; inline;
+    class function CompareExchange(var Target: Integer; Value: Integer; Comparand: Integer; out Succeeded: Boolean): Integer; overload; static;
+    class function CompareExchange(var Target: Int64; Value: Int64; Comparand: Int64): Int64; overload; static; inline;
+    class function CompareExchange(var Target: TObject; Value: TObject; Comparand: TObject): TObject; overload; static; inline;
+    class function CompareExchange(var Target: Double; Value: Double; Comparand: Double): Double; overload; static; inline;
+    class function CompareExchange(var Target: Single; Value: Single; Comparand: Single): Single; overload; static; inline;
+{$ifndef VER3_0}
+    generic class function CompareExchange<T: class>(var Target: T; Value: T; Comparand: T): T; overload; static; inline;
+{$endif}
+    class function Decrement(var Target: Integer): Integer; overload; static; inline;
+    class function Decrement(var Target: Int64): Int64; overload; static; inline;
+    class function Exchange(var Target: Pointer; Value: Pointer): Pointer; overload; static; inline;
+    class function Exchange(var Target: Integer; Value: Integer): Integer; overload; static; inline;
+    class function Exchange(var Target: Int64; Value: Int64): Int64; overload; static; inline;
+    class function Exchange(var Target: TObject; Value: TObject): TObject; overload; static; inline;
+    class function Exchange(var Target: Double; Value: Double): Double; overload; static; inline;
+    class function Exchange(var Target: Single; Value: Single): Single; overload; static; inline;
+{$ifndef VER3_0}
+    generic class function Exchange<T: class>(var Target: T; Value: T): T; overload; static; inline;
+{$endif}
+    class function Increment(var Target: Integer): Integer; overload; static; inline;
+    class function Increment(var Target: Int64): Int64; overload; static; inline;
+    class function Read(var Target: Int64): Int64; static; inline;
+  end;
+
 implementation
 
 Resourcestring
@@ -203,4 +235,147 @@ begin
   inherited Create(nil, True, False, '');
 end;
 
+class function TInterlocked.Add(var Target: Integer; Increment: Integer): Integer; overload; static; inline;
+begin
+  InterLockedExchangeAdd(Target, Increment); // returns the previous value
+  Result := Target;
+end;
+
+class function TInterlocked.Add(var Target: Int64; Increment: Int64): Int64; overload; static; inline;
+begin
+  InterLockedExchangeAdd64(Target, Increment); // returns the previous value
+  Result := Target;
+end;
+
+class function TInterlocked.BitTestAndClear(var Target: Integer; BitOffset: TIntegerBitOffset): Boolean; static;
+var
+  OldValue, ChangedValue: Integer;
+begin
+{ * can't use two calls as this is not atomic
+  // get actual value
+  OldValue := InterlockedCompareExchange(Target, 0, 0);
+  // bit set?
+  Result := OldValue.TestBit(BitOffset);
+  ChangedValue := OldValue.ClearBit(BitOffset);
+  // write new value with bit set to zero if value is still the same in target
+  InterlockedCompareExchange(Target, ChangedValue, OldValue);
+}
+end;
+
+class function TInterlocked.BitTestAndSet(var Target: Integer; BitOffset: TIntegerBitOffset): Boolean; static;
+var
+  OldValue, ChangedValue: Integer;
+begin
+{ * can't use two calls as this is not atomic
+  // get actual value
+  OldValue := InterlockedCompareExchange(Target, 0, 0);
+  // bit set?
+  Result := OldValue.TestBit(BitOffset);
+  ChangedValue := OldValue.SetBit(BitOffset);
+  // write new value with bit set to one if value is still the same in target
+  InterlockedCompareExchange(Target, ChangedValue, OldValue);
+}
+end;
+
+class function TInterlocked.CompareExchange(var Target: Pointer; Value: Pointer; Comparand: Pointer): Pointer; overload; static; inline;
+begin
+  Result := InterlockedCompareExchange(Target, Value, Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: Integer; Value: Integer; Comparand: Integer): Integer; overload; static; inline;
+begin
+  Result := InterlockedCompareExchange(Target, Value, Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: Integer; Value: Integer; Comparand: Integer; out Succeeded: Boolean): Integer; overload; static;
+begin
+  Result := InterlockedCompareExchange(Target, Value, Comparand);
+  Succeeded := (Result = Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: Int64; Value: Int64; Comparand: Int64): Int64; overload; static; inline;
+begin
+  Result := InterlockedCompareExchange64(Target, Value, Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: TObject; Value: TObject; Comparand: TObject): TObject; overload; static; inline;
+begin
+  Result := TObject(InterlockedCompareExchange(Pointer(Target), Pointer(Value), Pointer(Comparand)));
+end;
+
+class function TInterlocked.CompareExchange(var Target: Double; Value: Double; Comparand: Double): Double; overload; static; inline;
+begin
+end;
+
+class function TInterlocked.CompareExchange(var Target: Single; Value: Single; Comparand: Single): Single; overload; static; inline;
+begin
+end;
+
+{$ifndef VER3_0}
+generic class function TInterlocked.CompareExchange<T>(var Target: T; Value: T; Comparand: T): T; overload; static; inline;
+begin
+  Result := T(InterlockedCompareExchange(Pointer(Target), Pointer(Value), Pointer(Comparand)));
+end;
+{$endif}
+
+class function TInterlocked.Decrement(var Target: Integer): Integer; overload; static; inline;
+begin
+  Result := InterLockedDecrement(Target); // returns the new value
+end;
+
+class function TInterlocked.Decrement(var Target: Int64): Int64; overload; static; inline;
+begin
+  Result := InterLockedDecrement64(Target); // returns the new value
+end;
+
+class function TInterlocked.Exchange(var Target: Pointer; Value: Pointer): Pointer; overload; static; inline;
+begin
+  Result := InterLockedExchange(Target, Value);
+end;
+
+class function TInterlocked.Exchange(var Target: Integer; Value: Integer): Integer; overload; static; inline;
+begin
+  Result := InterLockedExchange(Target, Value);
+end;
+
+class function TInterlocked.Exchange(var Target: Int64; Value: Int64): Int64; overload; static; inline;
+begin
+  Result := InterLockedExchange64(Target, Value);
+end;
+
+class function TInterlocked.Exchange(var Target: TObject; Value: TObject): TObject; overload; static; inline;
+begin
+  Result := TObject(InterLockedExchange(Pointer(Target), Pointer(Value)));
+end;
+
+class function TInterlocked.Exchange(var Target: Double; Value: Double): Double; overload; static; inline;
+begin
+end;
+
+class function TInterlocked.Exchange(var Target: Single; Value: Single): Single; overload; static; inline;
+begin
+end;
+
+{$ifndef VER3_0}
+generic class function TInterlocked.Exchange<T>(var Target: T; Value: T): T; overload; static; inline;
+begin
+  Result := T(InterLockedExchange(Pointer(Target), Pointer(Value)));
+end;
+{$endif}
+
+class function TInterlocked.Increment(var Target: Integer): Integer; overload; static; inline;
+begin
+  Result := InterLockedIncrement(Target); // returns the new value
+end;
+
+class function TInterlocked.Increment(var Target: Int64): Int64; overload; static; inline;
+begin
+  Result := InterLockedIncrement64(Target); // returns the new value
+end;
+
+class function TInterlocked.Read(var Target: Int64): Int64; static; inline;
+begin
+  Result := InterlockedCompareExchange64(Target, 0, 0);
+end;
+
 end.

Bi0T1N

2020-05-21 22:02

reporter   ~0122996

I forgot in my previous post to explicitly mention that TInterlocked.Add isn't fully atomic because InterLockedExchangeAdd returns the old value and thus the Result := Target is needed but in-between the value could have already be changed (doesn't happen/covered in the test as no threading is involved). This could be avoid by adding an InterlockedAdd intrinsic as recommended by NoName in 0037093 which returns the new value as stated in the MS docs.

Bi0T1N

2020-05-25 01:23

reporter   ~0123052

Please find attached the patch and tests with all functions from Delphi's TInterlocked class which can safely be implemented with the currently available Interlocked* functions. Those functions are tested in test/tinterlockedmt.pp and test/tinterlocked64mt.pp.
I'm going to create a separate issue for the missing Interlocked* functions.
01-Add_TInterlocked_with_currently_possible_functionality.patch (4,887 bytes)   
diff --git packages/fcl-base/src/syncobjs.pp packages/fcl-base/src/syncobjs.pp
index 84c0adebd4..b9e6e44993 100644
--- packages/fcl-base/src/syncobjs.pp
+++ packages/fcl-base/src/syncobjs.pp
@@ -81,6 +81,28 @@ type
       constructor Create;
    end;
 
+  TInterlocked = class sealed
+    class function CompareExchange(var Target: Pointer; Value: Pointer; Comparand: Pointer): Pointer; overload; static; inline;
+    class function CompareExchange(var Target: Integer; Value: Integer; Comparand: Integer): Integer; overload; static; inline;
+    class function CompareExchange(var Target: Int64; Value: Int64; Comparand: Int64): Int64; overload; static; inline;
+    class function CompareExchange(var Target: TObject; Value: TObject; Comparand: TObject): TObject; overload; static; inline;
+{$ifndef VER3_0}
+    generic class function CompareExchange<T: class>(var Target: T; Value: T; Comparand: T): T; overload; static; inline;
+{$endif}
+    class function Decrement(var Target: Integer): Integer; overload; static; inline;
+    class function Decrement(var Target: Int64): Int64; overload; static; inline;
+    class function Exchange(var Target: Pointer; Value: Pointer): Pointer; overload; static; inline;
+    class function Exchange(var Target: Integer; Value: Integer): Integer; overload; static; inline;
+    class function Exchange(var Target: Int64; Value: Int64): Int64; overload; static; inline;
+    class function Exchange(var Target: TObject; Value: TObject): TObject; overload; static; inline;
+{$ifndef VER3_0}
+    generic class function Exchange<T: class>(var Target: T; Value: T): T; overload; static; inline;
+{$endif}
+    class function Increment(var Target: Integer): Integer; overload; static; inline;
+    class function Increment(var Target: Int64): Int64; overload; static; inline;
+    class function Read(var Target: Int64): Int64; static; inline;
+  end;
+
 implementation
 
 Resourcestring
@@ -203,4 +225,83 @@ begin
   inherited Create(nil, True, False, '');
 end;
 
+class function TInterlocked.CompareExchange(var Target: Pointer; Value: Pointer; Comparand: Pointer): Pointer; overload; static; inline;
+begin
+  Result := InterlockedCompareExchange(Target, Value, Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: Integer; Value: Integer; Comparand: Integer): Integer; overload; static; inline;
+begin
+  Result := InterlockedCompareExchange(Target, Value, Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: Int64; Value: Int64; Comparand: Int64): Int64; overload; static; inline;
+begin
+  Result := InterlockedCompareExchange64(Target, Value, Comparand);
+end;
+
+class function TInterlocked.CompareExchange(var Target: TObject; Value: TObject; Comparand: TObject): TObject; overload; static; inline;
+begin
+  Result := TObject(InterlockedCompareExchange(Pointer(Target), Pointer(Value), Pointer(Comparand)));
+end;
+
+{$ifndef VER3_0}
+generic class function TInterlocked.CompareExchange<T>(var Target: T; Value: T; Comparand: T): T; overload; static; inline;
+begin
+  Result := T(InterlockedCompareExchange(Pointer(Target), Pointer(Value), Pointer(Comparand)));
+end;
+{$endif}
+
+class function TInterlocked.Decrement(var Target: Integer): Integer; overload; static; inline;
+begin
+  Result := InterLockedDecrement(Target);
+end;
+
+class function TInterlocked.Decrement(var Target: Int64): Int64; overload; static; inline;
+begin
+  Result := InterLockedDecrement64(Target);
+end;
+
+class function TInterlocked.Exchange(var Target: Pointer; Value: Pointer): Pointer; overload; static; inline;
+begin
+  Result := InterLockedExchange(Target, Value);
+end;
+
+class function TInterlocked.Exchange(var Target: Integer; Value: Integer): Integer; overload; static; inline;
+begin
+  Result := InterLockedExchange(Target, Value);
+end;
+
+class function TInterlocked.Exchange(var Target: Int64; Value: Int64): Int64; overload; static; inline;
+begin
+  Result := InterLockedExchange64(Target, Value);
+end;
+
+class function TInterlocked.Exchange(var Target: TObject; Value: TObject): TObject; overload; static; inline;
+begin
+  Result := TObject(InterLockedExchange(Pointer(Target), Pointer(Value)));
+end;
+
+{$ifndef VER3_0}
+generic class function TInterlocked.Exchange<T>(var Target: T; Value: T): T; overload; static; inline;
+begin
+  Result := T(InterLockedExchange(Pointer(Target), Pointer(Value)));
+end;
+{$endif}
+
+class function TInterlocked.Increment(var Target: Integer): Integer; overload; static; inline;
+begin
+  Result := InterLockedIncrement(Target);
+end;
+
+class function TInterlocked.Increment(var Target: Int64): Int64; overload; static; inline;
+begin
+  Result := InterLockedIncrement64(Target);
+end;
+
+class function TInterlocked.Read(var Target: Int64): Int64; static; inline;
+begin
+  Result := InterlockedCompareExchange64(Target, 0, 0);
+end;
+
 end.
TInterlocked_tests-2.pas (4,765 bytes)   
program TInterlocked_tests;

{$mode Delphi}

uses
  SysUtils, SyncObjs, Classes;

var
  i32: Integer;
  New32, Old32: Integer;
  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 integer 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 *}
{
  i32 := 96;
  Changed := TInterlocked.BitTestAndClear(i32, 6);
  if Changed <> True then halt(62);
  if i32 <> 32 then halt(63);
}
  {* test BitTestAndSet usage *}
{
  Changed := TInterlocked.BitTestAndSet(i32, 4);
  if Changed <> False then halt(64);
  if i32 <> 48 then halt(65);
}
  writeln('testing of TInterlocked methods ended');
  readln;
end.
TInterlocked_tests-2.pas (4,765 bytes)   

Issue History

Date Modified Username Field Change
2020-05-17 00:54 NoName New Issue
2020-05-20 18:10 Bi0T1N Note Added: 0122957
2020-05-20 18:11 Bi0T1N Note Edited: 0122957 View Revisions
2020-05-20 18:24 Thaddy de Koning Note Added: 0122959
2020-05-20 18:25 Thaddy de Koning Note Edited: 0122959 View Revisions
2020-05-20 20:54 Bi0T1N Note Added: 0122963
2020-05-20 20:54 Bi0T1N File Added: TInterlocked_tests.pas
2020-05-20 20:54 Bi0T1N File Added: 01-Add_TInterlocked_without_Single_Double_BitTest.patch
2020-05-21 22:02 Bi0T1N Note Added: 0122996
2020-05-25 01:23 Bi0T1N Note Added: 0123052
2020-05-25 01:23 Bi0T1N File Added: 01-Add_TInterlocked_with_currently_possible_functionality.patch
2020-05-25 01:23 Bi0T1N File Added: TInterlocked_tests-2.pas