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

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

interface

uses
  DUnitX.TestFramework, TestBase, DynamicArray, SortedArray;

type
  [TestFixture]
  TSortedArrayFloatTest<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('TestB','22;1;0;54;4, 0;1;4;22;54')]
    [TestCase('TestC','0;1;0;0;0, 0;0;0;0;1')]
    [TestCase('TestD','0;-1;0;0;0, -1;0;0;0;0')]
    [TestCase('TestE','0;1;0;-1;0, -1;0;0;0;1')]
    [TestCase('TestF','-4;-55555;-1;-137;0, -55555;-137;-4;-1;0')]
    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, 555, -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, -1, -1')]
    [TestCase('TestC4','0;1;0;0;0, 2, -6')]
    [TestCase('TestC5','0;1;0;0;0, 3, -6')]
    [TestCase('TestD1','0;-1;0;0;0, -1, 0 ')]
    [TestCase('TestD2','0;-1;0;0;0, 0, 1 ')]
    [TestCase('TestD3','0;-1;0;0;0, 1, -6')]
    [TestCase('TestD4','0;-1;0;0;0, 2, -6')]
    [TestCase('TestE1','0;1;0;-1;0, -1, 0')]
    [TestCase('TestE2','0;1;0;-1;0, 0, 1 ')]
    [TestCase('TestE3','0;1;0;-1;0, 1, 4 ')]
    [TestCase('TestE4','0;1;0;-1;0, 2, -6 ')]
    [TestCase('TestE5','0;1;0;-1;0, -2, -1')]
    [TestCase('TestF1','-4;-5555;-1;-137;0, -5556, -1')]
    [TestCase('TestF2','-4;-5555;-1;-137;0, -5555, 0')]
    [TestCase('TestF3','-4;-5555;-1;-137;0, -5554, -2')]
    [TestCase('TestF4','-4;-5555;-1;-137;0, -555, -2')]
    [TestCase('TestF5','-4;-5555;-1;-137;0, -137, 1')]
    [TestCase('TestF6','-4;-5555;-1;-137;0, 0, 4')]
    [TestCase('TestF7','-4;-5555;-1;-137;0, -1, 3')]
    [TestCase('TestF8','-4;-5555;-1;-137;0, -2, -4')]
    [TestCase('TestF9','-4;-5555;-1;-137;0, 1, -6')]
    [TestCase('TestF10','-4;-5555;-1;-137;0, 2, -6')]
    procedure TestSortedIndexOf(AValue1, AValue2, AValue3: string);

  end;

implementation

uses SysUtils, System.Generics.Defaults;

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

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

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

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

 // cmp := 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 TSortedArrayFloatTest<T,A>.TestSortedOne;
var
  val: T;
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');

end;

procedure TSortedArrayFloatTest<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 TSortedArrayFloatTest<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 := TComparer<T>.Default;

  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
  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.AreEqual<T>(val1, val2);
  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 TSortedArrayFloatTest<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 TSortedArrayFloatTest<T,A>.TestSortedIndexOf(AValue1, AValue2, AValue3: string);
var
  arr: THArrayG<string>;
  i: Integer;
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 val := CreateValue<T>(StrToInt(Trim(AValue2)));
    Assert.AreEqual(StrToInt(Trim(AValue3)), array1.InternalIndexOfFrom(val, 0));

  finally
    arr.Free;
  end;
end;


initialization

  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Single, THArraySorted<Single>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Extended, THArraySorted<Extended>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Double, THArraySorted<Double>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Real, THArraySorted<Real>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Currency, THArraySorted<Currency>>);

  //=====================================================================================
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Single, THArraySorted<Single, TMyComparer<Single>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Extended, THArraySorted<Extended, TMyComparer<Extended>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Double, THArraySorted<Double, TMyComparer<Double>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Real, THArraySorted<Real, TMyComparer<Real>>>);
  TDUnitX.RegisterTestFixture(TSortedArrayFloatTest<Currency, THArraySorted<Currency, TMyComparer<Currency>>>);

end.