dynamicarrays/prj/Delphi/DynamicArraysTests/SortedArrayUIntTest.pas - master - lasersquad/DynamicArrays

dynamicarrays/prj/Delphi/DynamicArraysTests/SortedArrayUIntTest.pas
339 строк15 KB
lasersquad0
Added new data types for testing
14 июл 2025, 14:36
14 июл 2025, 14:36f02b20a
unit SortedArrayUIntTest;

interface

uses
  DUnitX.TestFramework, System.Generics.Defaults, TestBase, DynamicArray, SortedArray;

type
  [TestFixture]
  TSortedArrayUIntTest<T: constructor; A: THCustomArraySorted<T>> = class(TTestBase)
  private type
    TSortedArray = A;
  private
    array1: TSortedArray;
    procedure VerifySorting(arr: TSortedArray);

  public
    [TearDownFixture]
    procedure TearDownFixture; // this method is called when all tests of this fixture are executed. so we have to free objects from FObjects
    [Setup]
    procedure Setup;
    [TearDown]
    procedure TearDown;
    [Test]
    procedure TestSortedEmpty;
    [Test]
    procedure TestSortedOne;
    [Test]
    procedure TestSortedTwo;

    [TestCase('TestA1','')]
    [TestCase('TestA2',',')]
    [TestCase('TestA3',',,')]
    [TestCase('TestA4','1;3;4;2, 1;2;3;4')]
    [TestCase('TestA5','1;3;4;2, 1;2;3;4')]
    [TestCase('TestB','22;1;0;54;4, 0;1;4;22;54')]
    [TestCase('TestC','54;22;4;1;0, 0;1;4;22;54')]
    [TestCase('TestD','0;1;0;0;0, 0;0;0;0;1')]
    [TestCase('TestF','4;115;1;98;0, 0;1;4;98;115')]
    [TestCase('TestE','0;1;0;1000;0, 0;0;0;1;1000')]
    procedure TestSorted1(AValue1, Avalue2: string);

    [TestCase('TestA1','1;3;4;5, 1, 0')]
    [TestCase('TestA2','1;3;4;5, 4, 2')]
    [TestCase('TestA3','1;3;4;5, 2, -2')]
    [TestCase('TestA4','1;3;4;5, 6, -5')]
    [TestCase('TestB1','22;1;0;54;4, 0, 0')]
    [TestCase('TestB2','22;1;0;54;4, 1, 1')]
    [TestCase('TestB3','22;1;0;54;4, 4, 2')]
    [TestCase('TestB4','22;1;0;54;4, 10, -4')]
    [TestCase('TestB5','22;1;0;54;4, 11, -4')]
    [TestCase('TestB6','22;1;0;54;4, 21, -4')]
    [TestCase('TestB7','22;1;0;54;4, 23, -5')]
    [TestCase('TestB8','22;1;0;54;4, 53, -5')]
    [TestCase('TestB9','22;1;0;54;4, 54, 4')]
    [TestCase('TestB10','22;1;0;54;4, 55, -6')]
    [TestCase('TestB11','22;1;0;54;4, 120, -6')]
    [TestCase('TestC1','0;1;0;0;0, 0, 0')]
    [TestCase('TestC2','0;1;0;0;0, 1, 4 ')]
    [TestCase('TestC3','0;1;0;0;0, 2, -6')]
    [TestCase('TestC4','0;1;0;0;0, 3, -6')]
    [TestCase('TestD2','0;0;1;0;0, 0, 0 ')]
    [TestCase('TestD3','0;0;0;0;0, 1, -6')]
    [TestCase('TestE2','0;1;1;1;0, 0, 0 ')]
    [TestCase('TestE3','0;1;1;1;0, 1, 2 ')]
    [TestCase('TestE4','0;1;0;1;1, 2, -6 ')]
    [TestCase('TestE5','0;1;0;0;1, 2, -6')]
    procedure TestSortedIndexOf(AValue1, AValue2, AValue3: string);

  end;

implementation

uses SysUtils;


procedure TSortedArrayUIntTest<T,A>.Setup;
begin
  array1 := TSortedArray.Create;
end;

procedure TSortedArrayUIntTest<T,A>.TearDown;
begin
  FreeAndNil(array1);
end;

procedure TSortedArrayUIntTest<T,A>.TearDownFixture;
begin
  FreeTObjects;
end;

procedure TSortedArrayUIntTest<T,A>.VerifySorting(arr: TSortedArray);
var
  i: Cardinal;
  //cmp: IComparer<T>;
begin
  if arr.Count = 0 then exit;

  //cmp := arr.GetComparer; //TComparer<T>.Default;

  for i := 1 to arr.Count - 1 do
    Assert.IsTrue(arr.Compare(arr.Value[i - 1], arr.Value[i]) <= 0, '*** Array is NOT sorted ***');

end;

procedure TSortedArrayUIntTest<T,A>.TestSortedOne;
var
  val: T;
//  valObj: TObject absolute val;
begin
  val := CreateValue<T>(17);
  array1.AddValue(val);
  Assert.AreEqual(1, array1.Count);
  Assert.AreEqual(0, array1.IndexOf(val));
  Assert.AreEqual<T>(array1.GetValuePointer(0)^, val);
  array1.DeleteValue(0);
  Assert.AreEqual(0, array1.Count);
  Assert.WillRaise(procedure begin array1.GetValuePointer(0) end, ERangeError, 'GetValuePointer');
  Assert.WillRaise(procedure begin array1.SelectionSort(nil) end,  EInvalidOpException, 'selectionsort');
  Assert.WillRaise(procedure begin array1.InsertSort(nil) end, EInvalidOpException, 'insertsort');
  Assert.WillRaise(procedure begin array1.QuickSort(nil) end,  EInvalidOpException, 'quicksort');
  Assert.WillRaise(procedure begin array1.BubbleSort(nil) end,  EInvalidOpException, 'bubblesort');
  Assert.WillRaise(procedure begin array1.ShakerSort(nil) end,  EInvalidOpException, 'shakersort');

 // if TypeInfo(T) = TypeInfo(TObject) then valObj.Free;

end;

procedure TSortedArrayUIntTest<T,A>.TestSortedTwo;
var
  val1, val2: T;
 // valObj1: TObject absolute val1;
 // valObj2: TObject absolute val2;
begin
  val1 := CreateValue<T>(9);
  val2 := CreateValue<T>(3);
  array1.AddValue(val1);
  array1.AddValue(val2);

  Assert.AreEqual(2, array1.Count);
  Assert.AreEqual(1, array1.IndexOf(val1));
  Assert.AreEqual(0, array1.IndexOf(val2));
  Assert.AreEqual<T>(array1.GetValue(0), val2);
  Assert.AreEqual<T>(array1.GetValue(1), val1);
  Assert.AreEqual<T>(array1.GetValuePointer(0)^, val2);
  Assert.AreEqual<T>(array1.GetValuePointer(1)^, val1);
  array1.DeleteValue(0);
  Assert.AreEqual(1, array1.Count);
  Assert.AreEqual<T>(array1.Value[0], val1);
  Assert.WillRaise(procedure begin array1.SelectionSort(nil) end,  EInvalidOpException, 'selectionsort');
  Assert.WillRaise(procedure begin array1.InsertSort(nil) end, EInvalidOpException, 'insertsort');
  Assert.WillRaise(procedure begin array1.QuickSort(nil) end,  EInvalidOpException, 'quicksort');
  Assert.WillRaise(procedure begin array1.BubbleSort(nil) end,  EInvalidOpException, 'bubblesort');
  Assert.WillRaise(procedure begin array1.ShakerSort(nil) end,  EInvalidOpException, 'shakersort');

 // var TypeInfoPtr := TypeInfo(T);

//   if (TypeInfoPtr = TypeInfo(TObject)) OR (TypeInfoPtr = TypeInfo(THArrayG<Integer>)) then begin
 //    valObj1.Free;
 //    valObj2.Free;
//   end;
end;

procedure TSortedArrayUIntTest<T,A>.TestSorted1(AValue1, Avalue2: string);
var
  arr: THArrayG<string>;
  i: Integer;
  //cmp: IComparer<T>;
  val1, val2: T;
//  valToFree: T;
 // valObj: TObject absolute valToFree;
begin
  arr := THArrayG<string>.Create;
  //cmp := array1.GetComparer;

  HGetTokens(AValue1, ';', False, arr);
  if AValue1 = '' then Assert.AreEqual(0, arr.Count);

  for i := 1 to arr.Count do
    array1.AddValue(CreateValue<T>(StrToInt(Trim(arr[i - 1]))));

  VerifySorting(array1);

 // code below does not work for strings and for TObject and all descendants.
 // because strings are compared a bit differently than Integers.
 // and for TObject CreateValue<T>() always creates a new instance

  var TypeInfoPtr := TypeInfo(T);
  if (TypeInfoPtr <> TypeInfo(TObject)) then begin // cannot compare TObjects at the moment
    arr.Clear;
    HGetTokens(AValue2, ';', False, arr);

    for i := 1 to array1.Count do begin
      val1 := array1.Value[i - 1];
      val2 := CreateValue<T>(StrToInt(arr[i - 1]));
      Assert.IsTrue(array1.Compare(val1, val2) = 0);
    end;
  end;

  { var TypeInfoPtr := TypeInfo(T);
   if (TypeInfoPtr = TypeInfo(TObject)) OR (TypeInfoPtr = TypeInfo(THArrayG<Integer>)) then
     for i := 1 to arr.Count do begin
       valToFree :=	array1[i - 1];
       ValObj.Free;
     end;
   }
  arr.Free;
end;

procedure TSortedArrayUIntTest<T,A>.TestSortedEmpty;
var
  arr: THArrayG<T>;
begin
  Assert.AreEqual(0, array1.Count);
  Assert.WillRaise(procedure begin array1.SelectionSort(nil) end,  EInvalidOpException, 'selectionsort');
  Assert.WillRaise(procedure begin array1.InsertSort(nil) end, EInvalidOpException, 'insertsort');
  Assert.WillRaise(procedure begin array1.QuickSort(nil) end,  EInvalidOpException, 'quicksort');
  Assert.WillRaise(procedure begin array1.BubbleSort(nil) end,  EInvalidOpException, 'bubblesort');
  Assert.WillRaise(procedure begin array1.ShakerSort(nil) end,  EInvalidOpException, 'shakersort');

  arr := array1;
  Assert.WillRaise(procedure begin arr.InsertValue(0, CreateValue<T>(3)) end, EInvalidInsert, 'InsertValue');
  Assert.WillRaise(procedure begin arr.AddMany(CreateValue<T>(4), 40) end, EInvalidInsert, 'AddMany');
  Assert.WillRaise(procedure begin arr.InsertMany(1, CreateValue<T>(7), 10) end, EInvalidInsert, 'InsertMany');
  Assert.WillRaise(procedure begin arr.UpdateMany(2, CreateValue<T>(13), 20) end, EInvalidInsert, 'UpdateMany');
  Assert.WillRaise(procedure begin arr.SetValue(1, CreateValue<T>(5)) end, EInvalidInsert, 'SetValue');
  Assert.WillRaise(procedure begin arr.Swap(1, 2) end, EInvalidOpException, 'Swap');
end;

procedure TSortedArrayUIntTest<T,A>.TestSortedIndexOf(AValue1, AValue2, AValue3: string);
var
  arr: THArrayG<string>;
  i: Integer;
  val: T;
begin

  arr := THArrayG<string>.Create;

  try
    HGetTokens(AValue1, ';', False, arr);
    if AValue1 = '' then Assert.AreEqual(0, arr.Count);

    for i := 1 to arr.Count do
      array1.AddValue(CreateValue<T>(StrToInt(Trim(arr[i - 1]))));

    VerifySorting(array1);

    var TypeInfoPtr := TypeInfo(T);
    if (TypeInfoPtr <> TypeInfo(TObject)) then begin // cannot compare TObjects at the moment
      val := CreateValue<T>(StrToInt(Trim(AValue2)));
      Assert.AreEqual(StrToInt(Trim(AValue3)), array1.InternalIndexOfFrom(val, 0));
    end;

  finally
    arr.Free;
  end;
end;


initialization
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<TTypeKind, THArraySorted<TTypeKind>>);

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Cardinal, THArraySorted<Cardinal>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Byte, THArraySorted<Byte>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Word, THArraySorted<Word>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<NativeUInt, THArraySorted<NativeUInt>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<FixedUInt, THArraySorted<FixedUInt>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<LongWord, THArraySorted<LongWord>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<UInt64, THArraySorted<UInt64>>);


  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Char, THArraySorted<Char>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<AnsiChar, THArraySorted<AnsiChar>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<WideChar, THArraySorted<WideChar>>); // may be the same as 'Char'

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PChar, THArraySorted<PChar>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PByte, THArraySorted<PByte>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PInteger, THArraySorted<PInteger>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PCardinal, THArraySorted<PCardinal>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PFixedInt, THArraySorted<PFixedInt>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PSmallInt, THArraySorted<PSmallInt>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PNativeInt, THArraySorted<PNativeInt>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PLongInt, THArraySorted<PLongInt>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PInt64, THArraySorted<PInt64>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PUInt64, THArraySorted<PUInt64>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Pointer, THArraySorted<Pointer>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PPointer, THArraySorted<PPointer>>);

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PSingle, THArraySorted<PSingle>>);
  //TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PSingle, THArraySorted<PReal>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PDouble, THArraySorted<PDouble>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PExtended, THArraySorted<PExtended>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PCurrency, THArraySorted<PCurrency>>);

  // When T=THArrayG<Integer> we need a special comparer to properly compare two THArrayG<> arrays
  // TMyComparer below can do it, but here it is commended out because it will generate Assert exception
  //TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<THArrayG<Integer>, THArraySorted<THArrayG<Integer>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<TObject, THArraySorted<TObject>>);

  //===========================================================================================

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<TTypeKind, THArraySorted<TTypeKind, TMyComparer<TTypeKind>>>);

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Cardinal, THArraySorted<Cardinal, TMyComparer<Cardinal>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Byte, THArraySorted<Byte, TMyComparer<Byte>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Word, THArraySorted<Word, TMyComparer<Word>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<NativeUInt, THArraySorted<NativeUInt, TMyComparer<NativeUInt>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<FixedUInt, THArraySorted<FixedUInt, TMyComparer<FixedUInt>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<LongWord, THArraySorted<LongWord, TMyComparer<LongWord>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<UInt64, THArraySorted<UInt64, TMyComparer<UInt64>>>);

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Char, THArraySorted<Char, TMyComparer<Char>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<AnsiChar, THArraySorted<AnsiChar, TMyComparer<AnsiChar>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<WideChar, THArraySorted<WideChar, TMyComparer<WideChar>>>); // may be the same as 'Char'

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PChar, THArraySorted<PChar, TMyComparer<PChar>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PByte, THArraySorted<PByte, TMyComparer<PByte>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PInteger, THArraySorted<PInteger, TMyComparer<PInteger>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PCardinal, THArraySorted<PCardinal, TMyComparer<PCardinal>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PFixedInt, THArraySorted<PFixedInt, TMyComparer<PFixedInt>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PSmallInt, THArraySorted<PSmallInt, TMyComparer<PSmallInt>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PNativeInt, THArraySorted<PNativeInt, TMyComparer<PNativeInt>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PLongInt, THArraySorted<PLongInt, TMyComparer<PLongInt>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PInt64, THArraySorted<PInt64, TMyComparer<PInt64>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PUInt64, THArraySorted<PUInt64, TMyComparer<PUInt64>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<Pointer, THArraySorted<Pointer, TMyComparer<Pointer>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PPointer, THArraySorted<PPointer, TMyComparer<PPointer>>>);

  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PSingle, THArraySorted<PSingle, TMyComparer<PSingle>>>);
//  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PReal, THArraySorted<PReal, TMyComparer<PReal>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PDouble, THArraySorted<PDouble, TMyComparer<PDouble>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PExtended, THArraySorted<PExtended, TMyComparer<PExtended>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<PCurrency, THArraySorted<PCurrency, TMyComparer<PCurrency>>>);

  // TMyComparer can properly compare two THArrayg<> objects
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<THArrayG<Integer>, THArraySorted<THArrayG<Integer>, TMyComparer<THarrayG<Integer>>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayUIntTest<TObject, THArraySorted<TObject, TMyComparer<TObject>>>);

end.