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

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

interface

uses
  DUnitX.TestFramework, TestBase, DynamicArray, SortedArray;



type
  [TestFixture]
  TSortedArrayTest<T: constructor> = class(TTestBase)
  private type
    TSortedArray = THArraySorted<T, TMyComparer<T>>;
  private
    array1: TSortedArray;
    procedure VerifySorting(arr: THArrayG<T>);

  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;22;4;54')] // note - we compare strings here!
    [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;-115;-1;-98;0, -1;-115;-4;-98;0')] // note - we compare strings here!
    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, 3')]
    [TestCase('TestB4','22;1;0;54;4, 10, -3')]
    [TestCase('TestB5','22;1;0;54;4, 11, -3')]
    [TestCase('TestB6','22;1;0;54;4, 21, -3')]
    [TestCase('TestB7','22;1;0;54;4, 23, -4')]
    [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, 105, -3')]
    [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, -2')]
    [TestCase('TestF1','-4;-115;-1;-99;0, -116, -3')]
    [TestCase('TestF2','-4;-115;-1;-99;0, -115, 1')]
    [TestCase('TestF3','-4;-115;-1;-99;0, -114, -2')]
    [TestCase('TestF4','-4;-115;-1;-99;0, -105, -2')]
    [TestCase('TestF5','-4;-115;-1;-99;0, -99, 3')]
    [TestCase('TestF6','-4;-115;-1;-99;0, 0, 4')]
    [TestCase('TestF7','-4;-115;-1;-99;0, -1, 0')]
    [TestCase('TestF8','-4;-115;-1;-99;0, -2, -3')]
    [TestCase('TestF9','-4;-115;-1;-99;0, 1, -6')]
    [TestCase('TestF10','-4;-115;-1;-99;0, 2, -6')]
    procedure TestSortedIndexOf(AValue1, AValue2, AValue3: string);

  end;

implementation

uses SysUtils, System.Generics.Defaults;


procedure TSortedArrayTest<T>.Setup;
begin
  array1 := TSortedArray.Create;
end;

procedure TSortedArrayTest<T>.TearDown;
begin
  FreeAndNil(array1);
end;

procedure TSortedArrayTest<T>.TearDownFixture;
begin
  FreeTObjects;
end;

procedure TSortedArrayTest<T>.VerifySorting(arr: THArrayG<T>);
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(cmp.Compare(arr[i - 1], arr[i]) <= 0, '*** Array is NOT sorted ***');
end;

procedure TSortedArrayTest<T>.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 TSortedArrayTest<T>.TestSortedTwo;
var
  val1, val2: T;
//  cmp: TMyComparer<T>;
 // valObj1: TObject absolute val1;
 // valObj2: TObject absolute val2;
begin
  val1 := CreateValue<T>(9);  // NOTE! if T=TObject this test may not work properly because TObject are pointers and may have any value
  val2 := CreateValue<T>(3);

  array1.AddValue(val1);
  array1.AddValue(val2);

  Assert.AreEqual(2, array1.Count);
  Assert.AreEqual(0, array1.IndexOf(val2));
  Assert.AreEqual(1, array1.IndexOf(val1));
  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[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');

  //FreeAndNil(cmp);

 // var TypeInfoPtr := TypeInfo(T);

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

procedure TSortedArrayTest<T>.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;

  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); // array of proper results to compare

  for i := 1 to array1.Count do begin
    val1 := array1[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 TSortedArrayTest<T>.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 TSortedArrayTest<T>.TestSortedIndexOf(AValue1, AValue2, AValue3: string);
var
  arr: THArrayG<string>;
  i: Integer;
  val: T;
begin
  //if NOT (GetTypeKind(T) in FComparableTypes) then exit;

  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);

    val := CreateValue<T>(StrToInt(Trim(AValue2)));
    // InternalIndexOfFrom is used intentionally here
    Assert.AreEqual(StrToInt(Trim(AValue3)), array1.InternalIndexOfFrom(val, 0));

  finally
    arr.Free;
  end;
end;


initialization

  TDUnitX.RegisterTestFixture(TSortedArrayTest<String>);
  //TDUnitX.RegisterTestFixture(TSortedArrayTest<ShortString>); // generates internal compiler error
  TDUnitX.RegisterTestFixture(TSortedArrayTest<AnsiString>);
  TDUnitX.RegisterTestFixture(TSortedArrayTest<UnicodeString>);
  TDUnitX.RegisterTestFixture(TSortedArrayTest<WideString>);
  //TDUnitX.RegisterTestFixture(TSortedArrayTest<Boolean>);


end.