Browse Source

* started refactoring

master
bergmann 7 years ago
parent
commit
220a7bfce8
14 changed files with 2646 additions and 1687 deletions
  1. +3
    -7
      .gitignore
  2. BIN
     
  3. +107
    -0
      tests/tests.lpi
  4. +14
    -0
      tests/tests.lpr
  5. +216
    -0
      tests/tests.lps
  6. BIN
     
  7. +90
    -0
      tests/uTestHelper.pas
  8. +280
    -0
      tests/uutlLinkedListTests.pas
  9. +430
    -0
      tests/uutlListTest.pas
  10. +264
    -0
      tests/uutlQueueTests.pas
  11. +264
    -0
      tests/uutlStackTests.pas
  12. +11
    -116
      uutlAlgorithm.pas
  13. +55
    -51
      uutlExceptions.pas
  14. +912
    -1513
      uutlGenerics.pas

+ 3
- 7
.gitignore View File

@@ -1,9 +1,5 @@
*.dbg
lib/
*.exe
*.ini
*.log
*.profraw
*.heaptrc
*lib/
*/cache*
*.o
*.ppu
*.dbg

BIN
View File


+ 107
- 0
tests/tests.lpi View File

@@ -0,0 +1,107 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="10"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="tests"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<TextName Value="CompanyName.ProductName.AppName"/>
<TextDesc Value="Your application description."/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<Item1>
<PackageName Value="fptest_lcl"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
<Item3>
<PackageName Value="FCL"/>
</Item3>
</RequiredPackages>
<Units Count="7">
<Unit0>
<Filename Value="tests.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uutlQueueTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit1>
<Unit2>
<Filename Value="uTestHelper.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
<Unit3>
<Filename Value="uutlStackTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit3>
<Unit4>
<Filename Value="uutlListTest.pas"/>
<IsPartOfProject Value="True"/>
</Unit4>
<Unit5>
<Filename Value="..\uutlAlgorithm.pas"/>
<IsPartOfProject Value="True"/>
</Unit5>
<Unit6>
<Filename Value="uutlLinkedListTests.pas"/>
<IsPartOfProject Value="True"/>
</Unit6>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="tests"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value=".."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
</CodeGeneration>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

+ 14
- 0
tests/tests.lpr View File

@@ -0,0 +1,14 @@
program tests;

{$mode objfpc}{$H+}

uses
Interfaces, Forms, GUITestRunner, uutlQueueTests, uutlStackTests, uutlListTest, uutlAlgorithm, uutlLinkedListTests;

{$R *.res}

begin
Application.Initialize;
RunRegisteredTests;
end.


+ 216
- 0
tests/tests.lps View File

@@ -0,0 +1,216 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectSession>
<PathDelim Value="\"/>
<Version Value="10"/>
<BuildModes Active="Default"/>
<Units Count="20">
<Unit0>
<Filename Value="tests.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="2"/>
<CursorPos X="12" Y="11"/>
<UsageCount Value="29"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
<Filename Value="uutlQueueTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="234"/>
<CursorPos X="14" Y="244"/>
<UsageCount Value="29"/>
</Unit1>
<Unit2>
<Filename Value="uTestHelper.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="60"/>
<CursorPos Y="69"/>
<UsageCount Value="29"/>
</Unit2>
<Unit3>
<Filename Value="uutlStackTests.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="23"/>
<CursorPos X="33" Y="38"/>
<UsageCount Value="29"/>
</Unit3>
<Unit4>
<Filename Value="uutlListTest.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="-1"/>
<TopLine Value="24"/>
<CursorPos X="6" Y="33"/>
<UsageCount Value="29"/>
</Unit4>
<Unit5>
<Filename Value="..\uutlAlgorithm.pas"/>
<IsPartOfProject Value="True"/>
<CursorPos X="72" Y="10"/>
<UsageCount Value="23"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
<Filename Value="uutlLinkedListTests.pas"/>
<IsPartOfProject Value="True"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="249"/>
<CursorPos X="27" Y="259"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit6>
<Unit7>
<Filename Value="..\uutlGenerics.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="1184"/>
<CursorPos Y="1199"/>
<UsageCount Value="15"/>
</Unit7>
<Unit8>
<Filename Value="..\test.lpr"/>
<EditorIndex Value="-1"/>
<TopLine Value="55"/>
<CursorPos Y="72"/>
<UsageCount Value="10"/>
</Unit8>
<Unit9>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFramework.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="427"/>
<CursorPos X="3" Y="394"/>
<UsageCount Value="14"/>
</Unit9>
<Unit10>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\FPCUnitCompatibleInterface.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="54"/>
<CursorPos Y="69"/>
<UsageCount Value="12"/>
</Unit10>
<Unit11>
<Filename Value="G:\Eigene Datein\Projekte\Delphi\TotoStarRedesign\utils\uutlGenerics.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="105"/>
<CursorPos X="17" Y="109"/>
<UsageCount Value="10"/>
</Unit11>
<Unit12>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\fgl.pp"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="544"/>
<CursorPos X="15" Y="562"/>
<UsageCount Value="15"/>
</Unit12>
<Unit13>
<Filename Value="G:\Eigene Datein\Projekte\Delphi\TotoStarRedesign\utils\uutlInterfaces.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="59"/>
<CursorPos Y="17"/>
<UsageCount Value="15"/>
</Unit13>
<Unit14>
<Filename Value="..\uutlExceptions.pas"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<CursorPos X="3" Y="15"/>
<UsageCount Value="11"/>
</Unit14>
<Unit15>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpash.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="437"/>
<CursorPos X="5" Y="453"/>
<UsageCount Value="10"/>
</Unit15>
<Unit16>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\inc\objpas.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="999"/>
<CursorPos X="19" Y="1017"/>
<UsageCount Value="10"/>
</Unit16>
<Unit17>
<Filename Value="C:\Zusatzprogramme\Lazarus\components\fptest\src\TestFrameworkIfaces.pas"/>
<EditorIndex Value="-1"/>
<TopLine Value="36"/>
<CursorPos X="3" Y="51"/>
<UsageCount Value="10"/>
</Unit17>
<Unit18>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\intfh.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="6"/>
<CursorPos X="26" Y="18"/>
<UsageCount Value="10"/>
</Unit18>
<Unit19>
<Filename Value="C:\Zusatzprogramme\Lazarus\fpc\3.1.1\source\rtl\objpas\sysutils\sysuintf.inc"/>
<EditorIndex Value="-1"/>
<WindowIndex Value="1"/>
<TopLine Value="15"/>
<CursorPos X="3" Y="17"/>
<UsageCount Value="10"/>
</Unit19>
</Units>
<JumpHistory Count="10" HistoryIndex="9">
<Position1>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="247" TopLine="235"/>
</Position1>
<Position2>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="251" TopLine="235"/>
</Position2>
<Position3>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="252" TopLine="235"/>
</Position3>
<Position4>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="253" TopLine="235"/>
</Position4>
<Position5>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="254" TopLine="235"/>
</Position5>
<Position6>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="255" TopLine="235"/>
</Position6>
<Position7>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="256" TopLine="235"/>
</Position7>
<Position8>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="257" TopLine="235"/>
</Position8>
<Position9>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="258" TopLine="235"/>
</Position9>
<Position10>
<Filename Value="uutlLinkedListTests.pas"/>
<Caret Line="241" TopLine="235"/>
</Position10>
</JumpHistory>
</ProjectSession>
<Debugging>
<Watches Count="1">
<Item1>
<Expression Value="aElement^.data"/>
</Item1>
</Watches>
</Debugging>
</CONFIG>

BIN
View File


+ 90
- 0
tests/uTestHelper.pas View File

@@ -0,0 +1,90 @@
unit uTestHelper;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntfObjOwner = class(TTestCase)
private
fIntfObjCounter: Integer;

protected
procedure SetUp; override;

public
property IntfObjCounter: Integer read fIntfObjCounter;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntfObj = class(TObject, IUnknown)
private
fOwner: TIntfObjOwner;

private { IUnknown }
fRefCount : longint;
function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};

public
constructor Create(const aOwner: TIntfObjOwner);
destructor Destroy; override;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TIntfObjOwner/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TIntfObjOwner.SetUp;
begin
inherited SetUp;
fIntfObjCounter := 0;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TIntfObj//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TIntfObj.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
if getinterface(iid,obj)
then result := S_OK
else result := longint(E_NOINTERFACE);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TIntfObj._AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
_addref := InterLockedIncrement(fRefCount);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function TIntfObj._Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
begin
_Release := InterLockedDecrement(fRefCount);
if (_Release = 0) then
Destroy;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor TIntfObj.Create(const aOwner: TIntfObjOwner);
begin
inherited Create;
fOwner := aOwner;
inc(fOwner.fIntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
destructor TIntfObj.Destroy;
begin
dec(fOwner.fIntfObjCounter);
inherited Destroy;
end;

end.


+ 280
- 0
tests/uutlLinkedListTests.pas View File

@@ -0,0 +1,280 @@
unit uutlLinkedListTests;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework,
uTestHelper, uutlGenerics, uutlExceptions;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntList = specialize TutlLinkedList<Integer>;
TutlLinkedListTests = class(TTestCase)
private
fIntList: TIntList;

procedure AccessPropFirst;
procedure AccessPropLast;

protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure Prop_Count;
procedure Prop_IsEmpty;
procedure Prop_First;
procedure Prop_Last;

procedure Meth_PushFirst_PopFirst;
procedure Meth_PushLast_PopLast;
procedure Meth_InsertBefore;
procedure Meth_InsertAfter;
procedure Meth_Remove;
procedure Meth_Clear;

procedure Iterator;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlLinkedListTests///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.AccessPropFirst;
begin
fIntList.First;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.AccessPropLast;
begin
fIntList.Last;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.SetUp;
begin
inherited SetUp;
fIntList := TIntList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.TearDown;
begin
FreeAndNil(fIntList);
inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Prop_Count;
begin
AssertEquals(0, fIntList.Count);
fIntList.PushFirst(123);
AssertEquals(1, fIntList.Count);
fIntList.PushFirst(234);
AssertEquals(2, fIntList.Count);
fIntList.PopFirst(true);
AssertEquals(1, fIntList.Count);
fIntList.PopFirst(true);
AssertEquals(0, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Prop_IsEmpty;
begin
AssertEquals(true, fIntList.IsEmpty);
fIntList.PushFirst(123);
AssertEquals(false, fIntList.IsEmpty);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Prop_First;
var
i: TIntList.Iterator;
begin
AssertException('empty list does not raise exception when accessing First property', EutlInvalidOperation, @AccessPropFirst);
fIntList.PushLast(123);
fIntList.PushLast(234);
i := fIntList.First;
AssertEquals(123, i.Value);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Prop_Last;
var
i: TIntList.Iterator;
begin
AssertException('empty list does not raise exception when accessing First property', EutlInvalidOperation, @AccessPropLast);
fIntList.PushLast(123);
fIntList.PushLast(234);
i := fIntList.Last;
AssertEquals(234, i.Value);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_PushFirst_PopFirst;
begin
fIntList.PushFirst(123);
AssertEquals(123, fIntList.First.Value);
fIntList.PushFirst(234);
AssertEquals(234, fIntList.First.Value);
fIntList.PushFirst(345);
AssertEquals(345, fIntList.First.Value);
fIntList.PushFirst(456);
AssertEquals(456, fIntList.First.Value);

AssertEquals(456, fIntList.PopFirst(false));
AssertEquals(345, fIntList.First.Value);
AssertEquals( 0, fIntList.PopFirst(true));
AssertEquals(234, fIntList.First.Value);
AssertEquals(234, fIntList.PopFirst(false));
AssertEquals(123, fIntList.First.Value);
AssertEquals( 0, fIntList.PopFirst(true));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_PushLast_PopLast;
begin
fIntList.PushLast(123);
AssertEquals(123, fIntList.Last.Value);
fIntList.PushLast(234);
AssertEquals(234, fIntList.Last.Value);
fIntList.PushLast(345);
AssertEquals(345, fIntList.Last.Value);
fIntList.PushLast(456);
AssertEquals(456, fIntList.Last.Value);

AssertEquals(456, fIntList.PopLast(false));
AssertEquals(345, fIntList.Last.Value);
AssertEquals( 0, fIntList.PopLast(true));
AssertEquals(234, fIntList.Last.Value);
AssertEquals(234, fIntList.PopLast(false));
AssertEquals(123, fIntList.Last.Value);
AssertEquals( 0, fIntList.PopLast(true));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_InsertBefore;
var
it: TIntList.Iterator;
begin
fIntList.PushLast(123);
fIntList.PushLast(234);
fIntList.PushLast(345);
fIntList.PushLast(456);

it := fIntList.First;
fIntList.InsertBefore(it, 999);
AssertTrue(it.MovePrev);
AssertEquals(999, it.Value);
AssertEquals(5, fIntList.Count);

it := fIntList.Last;
fIntList.InsertBefore(it, 888);
AssertTrue(it.MovePrev);
AssertEquals(888, it.Value);
AssertEquals(6, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_InsertAfter;
var
it: TIntList.Iterator;
begin
fIntList.PushLast(123);
fIntList.PushLast(234);
fIntList.PushLast(345);
fIntList.PushLast(456);

it := fIntList.First;
fIntList.InsertAfter(it, 999);
AssertTrue(it.MoveNext);
AssertEquals(999, it.Value);
AssertEquals(5, fIntList.Count);

it := fIntList.Last;
fIntList.InsertAfter(it, 888);
AssertTrue(it.MoveNext);
AssertEquals(888, it.Value);
AssertEquals(6, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_Remove;
var
it: TIntList.Iterator;
begin
fIntList.PushLast(123);
fIntList.PushLast(234);
fIntList.PushLast(345);
fIntList.PushLast(456);

it := fIntList.First;
it.MoveNext;
fIntList.Remove(it);

AssertEquals(3, fIntList.Count);
AssertEquals(123, fIntList.First.Value);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Meth_Clear;
begin
fIntList.PushLast(123);
fIntList.PushLast(234);
fIntList.PushLast(345);
fIntList.PushLast(456);

AssertEquals(4, fIntList.Count);
fIntList.Clear;

AssertEquals(0, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlLinkedListTests.Iterator;
var
it1: TIntList.Iterator;
begin
fIntList.PushLast(123);
fIntList.PushLast(234);
fIntList.PushLast(345);
fIntList.PushLast(456);

it1 := fIntList.First;
AssertEquals(123, it1.Value);
AssertTrue (it1.IsValid);
AssertTrue (it1.Equals(fIntList.First));
AssertTrue (it1.MoveNext);
AssertEquals(234, it1.Value);
AssertTrue (it1.MoveNext);
AssertEquals(345, it1.Value);
AssertTrue (it1.MoveNext);
AssertEquals(456, it1.Value);
AssertTrue (it1.Equals(fIntList.Last));
AssertFalse (it1.MoveNext);
fIntList.PopLast;
AssertFalse (it1.IsValid);

it1 := fIntList.Last;
AssertEquals(345, it1.Value);
AssertTrue (it1.IsValid);
AssertTrue (it1.Equals(fIntList.Last));
AssertTrue (it1.MovePrev);
AssertEquals(234, it1.Value);
AssertTrue (it1.MovePrev);
AssertEquals(123, it1.Value);
AssertTrue (it1.Equals(fIntList.First));
AssertFalse (it1.MovePrev);
fIntList.PopFirst;
AssertFalse (it1.IsValid);
end;

initialization
RegisterTest(TutlLinkedListTests.Suite);

end.


+ 430
- 0
tests/uutlListTest.pas View File

@@ -0,0 +1,430 @@
unit uutlListTest;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework, contnrs,
uTestHelper, uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntList = specialize TutlList<Integer>;
TIntfList = specialize TutlList<IUnknown>;
TObjList = specialize TutlList<TObject>;

TutlListTest = class(TIntfObjOwner)
private
fIntList: TIntList;
fIntfList: TIntfList;
fObjList: TObjList;

protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure Prop_Count;
procedure Prop_First;
procedure Prop_last;
procedure Prop_Items;

procedure Meth_Add;
procedure Meth_Insert;
procedure Meth_Exchange;
procedure Meth_Move;
procedure Meth_Delete;
procedure Meth_Extract;
procedure Meth_PushFirst;
procedure Meth_PopFirst;
procedure Meth_PushLast;
procedure Meth_PopLast;
procedure Dtor_FreesAllItems;
procedure Meth_IndexOf;
procedure Meth_Extract_WithDefault;
procedure Meth_Remove;

procedure AddRemoveInterfaces;
procedure AddRemoveObject_OwnedByList;
procedure AddRemoveObject_NotOwnedByList;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlListTest//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.SetUp;
begin
inherited SetUp;
fIntList := TIntList.Create(true);
fIntfList := TIntfList.Create(true);
fObjList := TObjList.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.TearDown;
begin
FreeAndNil(fIntList);
FreeAndNil(fIntfList);
FreeAndNil(fObjList);
inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Prop_Count;
begin
AssertEquals(0, fIntList.Count);
fIntList.Add(123);
AssertEquals(1, fIntList.Count);
fIntList.Add(234);
AssertEquals(2, fIntList.Count);
fIntList.Add(345);
AssertEquals(3, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Prop_First;
begin
fIntList.Add(123);
AssertEquals(123, fIntList.First);
fIntList.Add(456);
AssertEquals(123, fIntList.First);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Prop_last;
begin
fIntList.Add(123);
AssertEquals(123, fIntList.Last);
fIntList.Add(456);
AssertEquals(456, fIntList.Last);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Prop_Items;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
AssertEquals(123, fIntList[0]);
AssertEquals(234, fIntList[1]);
AssertEquals(345, fIntList[2]);
AssertEquals(456, fIntList[3]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Add;
begin
fIntList.Add(123);
AssertEquals(fIntList.Count, 1);
AssertEquals(123, fIntList[0]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Insert;
begin
fIntList.Insert(0, 123);
fIntList.Insert(0, 456);
AssertEquals(fIntList.Count, 2);
AssertEquals(123, fIntList[1]);
AssertEquals(456, fIntList[0]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Exchange;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
fIntList.Exchange(1, 3);
AssertEquals(123, fIntList[0]);
AssertEquals(456, fIntList[1]);
AssertEquals(345, fIntList[2]);
AssertEquals(234, fIntList[3]);
AssertEquals(567, fIntList[4]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Move;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
fIntList.Move(1, 3);
AssertEquals(123, fIntList[0]);
AssertEquals(345, fIntList[1]);
AssertEquals(456, fIntList[2]);
AssertEquals(234, fIntList[3]);
AssertEquals(567, fIntList[4]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Delete;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
fIntList.Delete(2);
AssertEquals(4, fIntList.Count);
AssertEquals(456, fIntList[2]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Extract;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
AssertEquals(234, fIntList.Extract(1));
AssertEquals(4, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_PushFirst;
begin
fIntList.PushFirst(123);
fIntList.PushFirst(234);
AssertEquals(2, fIntList.Count);
AssertEquals(123, fIntList[1]);
AssertEquals(234, fIntList[0]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_PopFirst;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
AssertEquals(123, fIntList.PopFirst(false));
AssertEquals(234, fIntList.PopFirst(false));
AssertEquals(3, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_PushLast;
begin
fIntList.PushLast(123);
fIntList.PushLast(234);
fIntList.PushLast(345);
AssertEquals(3, fIntList.Count);
AssertEquals(123, fIntList[0]);
AssertEquals(234, fIntList[1]);
AssertEquals(345, fIntList[2]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_PopLast;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
AssertEquals(567, fIntList.PopLast(false));
AssertEquals(456, fIntList.PopLast(false));
AssertEquals(3, fIntList.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Dtor_FreesAllItems;
begin
fObjList.Add(TIntfObj.Create(self));
fObjList.Add(TIntfObj.Create(self));
FreeAndNil(fObjList);
AssertEquals(0, IntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_IndexOf;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
AssertEquals( 1, fIntList.IndexOf(234));
AssertEquals( 3, fIntList.IndexOf(456));
AssertEquals(-1, fIntList.IndexOf(999));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Extract_WithDefault;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
AssertEquals(234, fIntList.Extract(234, 999));
AssertEquals(999, fIntList.Extract(234, 999));
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.Meth_Remove;
begin
fIntList.Add(123);
fIntList.Add(234);
fIntList.Add(345);
fIntList.Add(456);
fIntList.Add(567);
fIntList.Remove(234);
AssertEquals(4, fIntList.Count);
AssertEquals(345, fIntList[1]);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.AddRemoveInterfaces;
var
i1: IUnknown;
begin
fIntfList.Add(TIntfObj.Create(self));
fIntfList.Add(TIntfObj.Create(self));
fIntfList.Add(TIntfObj.Create(self));
fIntfList.Exchange(0, 2);
fIntfList.Move(0, 2);
fIntfList.Delete(0);
fIntfList.Extract(0);
fIntfList.Clear;

fIntfList.Insert(0, TIntfObj.Create(self));
fIntfList.PopLast(true);

fIntfList.Insert(0, TIntfObj.Create(self));
fIntfList.PopLast(false);

fIntfList.Insert(0, TIntfObj.Create(self));
fIntfList.PopFirst(true);

fIntfList.Insert(0, TIntfObj.Create(self));
fIntfList.PopFirst(false);

i1 := TIntfObj.Create(self);
fIntfList.Insert(0, i1);
fIntfList.Extract(i1, nil);
i1 := nil;

i1 := TIntfObj.Create(self);
fIntfList.Insert(0, i1);
fIntfList.Remove(i1);
i1 := nil;

fIntfList.Add(TIntfObj.Create(self));
fIntfList[0] := TIntfObj.Create(self);
fIntfList.Clear;

AssertEquals(0, IntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.AddRemoveObject_OwnedByList;

function CreateObj: TObject;
begin
result := TIntfObj.Create(self);
end;

begin
fObjList.Add(CreateObj);
fObjList.Add(CreateObj);
fObjList.Add(CreateObj);
fObjList.Exchange(0, 2);
fObjList.Move(0, 2);
fObjList.Delete(0);
fObjList.Extract(0).Free;
fObjList.Clear;

fObjList.Add(CreateObj);
fObjList.PopLast(true);

fObjList.Add(CreateObj);
fObjList.PopLast(false).Free;

fObjList.Add(CreateObj);
fObjList.PopFirst(true);

fObjList.Add(CreateObj);
fObjList.PopFirst(false).Free;

fObjList.Add(CreateObj);
fObjList.Extract(fObjList[0], nil).Free;

fObjList.Add(CreateObj);
fObjList.Remove(fObjList[0]);

fObjList.Add(CreateObj);
fObjList[0] := CreateObj;
fObjList.Clear;

AssertEquals(0, IntfObjCounter);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlListTest.AddRemoveObject_NotOwnedByList;
var
lst: TObjectList;

function CreateObj: TObject;
begin
result := TIntfObj.Create(self);
lst.Add(result);
end;

begin
lst := TObjectList.Create(true);
try
fObjList.OwnsItems := false;

fObjList.Add(CreateObj);
fObjList.Add(CreateObj);
fObjList.Add(CreateObj);
fObjList.Exchange(0, 2);
fObjList.Move(0, 2);
fObjList.Delete(0);
fObjList.Extract(0);
fObjList.Clear;

fObjList.Add(CreateObj);
fObjList.PopLast(true);

fObjList.Add(CreateObj);
fObjList.PopLast(false);

fObjList.Add(CreateObj);
fObjList.PopFirst(true);

fObjList.Add(CreateObj);
fObjList.PopFirst(false);

fObjList.Add(CreateObj);
fObjList.Extract(fObjList[0], nil);

fObjList.Add(CreateObj);
fObjList.Remove(fObjList[0]);

fObjList.Add(CreateObj);
fObjList[0] := CreateObj;
fObjList.Clear;
finally
FreeAndNil(lst);
end;
AssertEquals(0, IntfObjCounter);
end;

initialization
RegisterTest(TutlListTest.Suite);

end.


+ 264
- 0
tests/uutlQueueTests.pas View File

@@ -0,0 +1,264 @@
unit uutlQueueTests;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework, contnrs, uTestHelper,
uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntQueue = specialize TutlQueue<Integer>;
TIntfQueue = specialize TutlQueue<IUnknown>;
TObjQueue = specialize TutlQueue<TObject>;
TutlQueueTests = class(TIntfObjOwner)
private
fIntQueue: TIntQueue;
fIntfQueue: TIntfQueue;
fObjQueue: TObjQueue;

protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure Prop_Count;
procedure Prop_Empty;
procedure Meth_Peek;
procedure Meth_EnqueueDequeue1000Times;
procedure Meth_EnqueueDequeue1000Items;
procedure Meth_EnqueueDequeue1000Items1000Times;
procedure Meth_EnqueueDequeue100Interfaces;
procedure Meth_EnqueueDequeue100_ObjectOwned_WithFree;
procedure Meth_EnqueueDequeue100_ObjectOwned_WithoutFree;
procedure Meth_EnqueueDequeue100_ObjectNotOwned_WithFree;
procedure Meth_EnqueueDequeue100_ObjectNotOwned_WithoutFree;
procedure Dtor_FreesAllItems;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQueueTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.SetUp;
begin
inherited SetUp;
fIntQueue := TIntQueue.Create(true);
fIntfQueue := TIntfQueue.Create(true);
fObjQueue := TObjQueue.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.TearDown;
begin
FreeAndNil(fIntQueue);
FreeAndNil(fIntfQueue);
FreeAndNil(fObjQueue);
inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Prop_Count;
begin
AssertEquals(0, fIntQueue.Count);
fIntQueue.Enqueue(123);
AssertEquals(1, fIntQueue.Count);
fIntQueue.Enqueue(234);
AssertEquals(2, fIntQueue.Count);
fIntQueue.Enqueue(345);
AssertEquals(3, fIntQueue.Count);
fIntQueue.Dequeue;
AssertEquals(2, fIntQueue.Count);
fIntQueue.Dequeue;
AssertEquals(1, fIntQueue.Count);
fIntQueue.Dequeue;
AssertEquals(0, fIntQueue.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Prop_Empty;
begin
AssertEquals(true, fIntQueue.IsEmpty);
fIntQueue.Enqueue(345);
AssertEquals(false, fIntQueue.IsEmpty);
fIntQueue.Dequeue;
AssertEquals(true, fIntQueue.IsEmpty);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_Peek;
begin
fIntQueue.Enqueue(123);
AssertEquals(123, fIntQueue.Peek);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue1000Times;
var
i, tmp: Integer;
begin
for i := 0 to 1000 do begin
fIntQueue.Enqueue(i);
tmp := fIntQueue.Dequeue;
AssertEquals(i, tmp);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue1000Items;
var
i, tmp: Integer;
begin
for i := 0 to 1000 do
fIntQueue.Enqueue(i);
for i := 0 to 1000 do begin
tmp := fIntQueue.Dequeue;
AssertEquals(i, tmp);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue1000Items1000Times;
var
i, j, tmp: Integer;
begin
for j := 0 to 1000 do begin
for i := 0 to 1000 do
fIntQueue.Enqueue(i);
for i := 0 to 1000 do begin
tmp := fIntQueue.Dequeue;
AssertEquals(i, tmp);
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue100Interfaces;
var
i: Integer;
begin
for i := 0 to 100 do begin
fIntfQueue.Enqueue(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
for i := 0 to 100 do begin
fIntfQueue.Dequeue;
AssertEquals(100 - i, IntfObjCounter);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectOwned_WithFree;
var
i: Integer;
begin
for i := 0 to 100 do begin
fObjQueue.Enqueue(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
for i := 0 to 100 do begin
AssertNull('dequeue returned non-zero item', fObjQueue.Dequeue(true));
AssertEquals(100 - i, IntfObjCounter);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectOwned_WithoutFree;
var
i: Integer;
lst: TObjectList;
obj: TObject;
begin
for i := 0 to 100 do begin
fObjQueue.Enqueue(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
for i := 0 to 100 do begin
fObjQueue.Dequeue(true);
AssertEquals(100 - i, IntfObjCounter);
end;

// free on dequeue
for i := 0 to 100 do begin
fObjQueue.Enqueue(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
lst := TObjectList.Create(true);
try
for i := 0 to 100 do begin
obj := fObjQueue.Dequeue(false);
AssertNotNull('dequeue returned zero item', obj);
lst.Add(obj);
AssertEquals(101, IntfObjCounter);
end;
finally
FreeAndNil(lst);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectNotOwned_WithFree;
var
lst: TObjectList;
obj: TObject;
i: Integer;
begin
lst := TObjectList.Create(true);
try
for i := 0 to 100 do begin
obj := TIntfObj.Create(self);
lst.Add(obj);
fObjQueue.Enqueue(obj);
AssertEquals(i+1, IntfObjCounter);
end;
fObjQueue.OwnsItems := false;
for i := 0 to 100 do begin
AssertNull('dequeue returned non-zero item', fObjQueue.Dequeue(true));
AssertEquals(101, IntfObjCounter);
end;
finally
FreeAndNil(lst);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Meth_EnqueueDequeue100_ObjectNotOwned_WithoutFree;
var
lst: TObjectList;
obj: TObject;
i: Integer;
begin
lst := TObjectList.Create(true);
try
for i := 0 to 100 do begin
obj := TIntfObj.Create(self);
lst.Add(obj);
fObjQueue.Enqueue(obj);
AssertEquals(i+1, IntfObjCounter);
end;
fObjQueue.OwnsItems := false;
for i := 0 to 100 do begin
AssertNotNull('dequeue returned zero item', fObjQueue.Dequeue(false));
AssertEquals(101, IntfObjCounter);
end;
finally
FreeAndNil(lst);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlQueueTests.Dtor_FreesAllItems;
begin
fObjQueue.Enqueue(TIntfObj.Create(self));
FreeAndNil(fObjQueue);
AssertEquals(0, IntfObjCounter);
end;

initialization
RegisterTest(TutlQueueTests.Suite);

end.


+ 264
- 0
tests/uutlStackTests.pas View File

@@ -0,0 +1,264 @@
unit uutlStackTests;

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, TestFramework, Contnrs,
uTestHelper, uutlGenerics;

type
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
TIntStack = specialize TutlStack<Integer>;
TIntfStack = specialize TutlStack<IUnknown>;
TObjStack = specialize TutlStack<TObject>;
TutlStackTests = class(TIntfObjOwner)
private
fIntStack: TIntStack;
fIntfStack: TIntfStack;
fObjStack: TObjStack;

protected
procedure SetUp; override;
procedure TearDown; override;

published
procedure Prop_Count;
procedure Prop_Empty;
procedure Meth_Peek;
procedure Meth_PushPop1000Times;
procedure Meth_PushPop1000Items;
procedure Meth_PushPop1000Items1000Times;
procedure Meth_PushPop100Interfaces;
procedure Meth_PushPop100_ObjectOwned_WithFree;
procedure Meth_PushPop100_ObjectOwnedByStack_WithoutFree;
procedure Meth_PushPop100_ObjectNotOwned_WithFree;
procedure Meth_PushPop100_ObjectNotOwned_WithoutFree;
procedure Dtor_FreesAllItems;
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlStackTests////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.SetUp;
begin
inherited SetUp;
fIntStack := TIntStack.Create(true);
fIntfStack := TIntfStack.Create(true);
fObjStack := TObjStack.Create(true);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.TearDown;
begin
FreeAndNil(fIntStack);
FreeAndNil(fIntfStack);
FreeAndNil(fObjStack);
inherited TearDown;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Prop_Count;
begin
AssertEquals(0, fIntStack.Count);
fIntStack.Push(123);
AssertEquals(1, fIntStack.Count);
fIntStack.Push(234);
AssertEquals(2, fIntStack.Count);
fIntStack.Push(345);
AssertEquals(3, fIntStack.Count);
fIntStack.Pop;
AssertEquals(2, fIntStack.Count);
fIntStack.Pop;
AssertEquals(1, fIntStack.Count);
fIntStack.Pop;
AssertEquals(0, fIntStack.Count);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Prop_Empty;
begin
AssertEquals(true, fIntStack.IsEmpty);
fIntStack.Push(345);
AssertEquals(false, fIntStack.IsEmpty);
fIntStack.Pop;
AssertEquals(true, fIntStack.IsEmpty);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_Peek;
begin
fIntStack.Push(123);
AssertEquals(123, fIntStack.Peek);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop1000Times;
var
i, tmp: Integer;
begin
for i := 0 to 1000 do begin
fIntStack.Push(i);
tmp := fIntStack.Pop;
AssertEquals(i, tmp);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop1000Items;
var
i, tmp: Integer;
begin
for i := 0 to 1000 do
fIntStack.Push(i);
for i := 0 to 1000 do begin
tmp := fIntStack.Pop;
AssertEquals(1000-i, tmp);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop1000Items1000Times;
var
i, j, tmp: Integer;
begin
for j := 0 to 1000 do begin
for i := 0 to 1000 do
fIntStack.Push(i);
for i := 0 to 1000 do begin
tmp := fIntStack.Pop;
AssertEquals(1000-i, tmp);
end;
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop100Interfaces;
var
i: Integer;
begin
for i := 0 to 100 do begin
fIntfStack.Push(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
for i := 0 to 100 do begin
fIntfStack.Pop;
AssertEquals(100 - i, IntfObjCounter);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop100_ObjectOwned_WithFree;
var
i: Integer;
begin
for i := 0 to 100 do begin
fObjStack.Push(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
for i := 0 to 100 do begin
AssertNull('Pop returned non-zero item', fObjStack.Pop(true));
AssertEquals(100 - i, IntfObjCounter);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop100_ObjectOwnedByStack_WithoutFree;
var
i: Integer;
lst: TObjectList;
obj: TObject;
begin
for i := 0 to 100 do begin
fObjStack.Push(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
for i := 0 to 100 do begin
fObjStack.Pop(true);
AssertEquals(100 - i, IntfObjCounter);
end;

// free on Pop
for i := 0 to 100 do begin
fObjStack.Push(TIntfObj.Create(self));
AssertEquals(i+1, IntfObjCounter);
end;
lst := TObjectList.Create(true);
try
for i := 0 to 100 do begin
obj := fObjStack.Pop(false);
AssertNotNull('Pop returned zero item', obj);
lst.Add(obj);
AssertEquals(101, IntfObjCounter);
end;
finally
FreeAndNil(lst);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop100_ObjectNotOwned_WithFree;
var
lst: TObjectList;
obj: TObject;
i: Integer;
begin
lst := TObjectList.Create(true);
try
for i := 0 to 100 do begin
obj := TIntfObj.Create(self);
lst.Add(obj);
fObjStack.Push(obj);
AssertEquals(i+1, IntfObjCounter);
end;
fObjStack.OwnsItems := false;
for i := 0 to 100 do begin
AssertNull('Pop returned non-zero item', fObjStack.Pop(true));
AssertEquals(101, IntfObjCounter);
end;
finally
FreeAndNil(lst);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Meth_PushPop100_ObjectNotOwned_WithoutFree;
var
lst: TObjectList;
obj: TObject;
i: Integer;
begin
lst := TObjectList.Create(true);
try
for i := 0 to 100 do begin
obj := TIntfObj.Create(self);
lst.Add(obj);
fObjStack.Push(obj);
AssertEquals(i+1, IntfObjCounter);
end;
fObjStack.OwnsItems := false;
for i := 0 to 100 do begin
AssertNotNull('Pop returned zero item', fObjStack.Pop(false));
AssertEquals(101, IntfObjCounter);
end;
finally
FreeAndNil(lst);
end;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
procedure TutlStackTests.Dtor_FreesAllItems;
begin
fObjStack.Push(TIntfObj.Create(self));
FreeAndNil(fObjStack);
AssertEquals(0, IntfObjCounter);
end;

initialization
RegisterTest(TutlStackTests.Suite);

end.


+ 11
- 116
uutlAlgorithm.pas View File

@@ -5,127 +5,22 @@ unit uutlAlgorithm;
interface

uses
Classes, SysUtils,
uutlInterfaces;
Classes, SysUtils;

type
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlQuickSort<T> = class(TObject)
public type
IList = specialize IutlList<T>;
IComparer = specialize IutlComparer<T>;

private
class procedure DoSort(
aList: IList;
aComparer: IComparer;
aLow: Integer;
aHigh: Integer);

public
class procedure Sort(
aList: IList;
aComparer: IComparer);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
generic TutlBinarySearch<T> = class(TObject)
public type
IList = specialize IutlReadOnlyList<T>;
IComparer = specialize IutlComparer<T>;

private
class function DoSearch(
aList: IList;
aComparer: IComparer;
const aMin: Integer;
const aMax: Integer;
constref aItem: T;
out aIndex: Integer): Boolean;

public
class function Search(
aList: IList;
aComparer: IComparer;
constref aItem: T;
out aIndex: Integer): Boolean;
end;
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean; overload;

implementation

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlQuickSort//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.DoSort(aList: IList; aComparer: IComparer; aLow: Integer; aHigh: Integer);
var
lo, hi: Integer;
p, tmp: T;
begin
repeat
lo := aLow;
hi := aHigh;
p := aList.GetItem((aLow + aHigh) div 2);
repeat
while (aComparer.Compare(p, aList.GetItem(lo)) > 0) do
lo := lo + 1;
while (aComparer.Compare(p, aList.GetItem(hi)) < 0) do
hi := hi - 1;
if (lo <= hi) then begin
tmp := aList.GetItem(lo);
aList.SetItem(lo, aList.GetItem(hi));
aList.SetItem(hi, tmp);
lo := lo + 1;
hi := hi - 1;
end;
until (lo > hi);

if (hi - aLow < aHigh - lo) then begin
if (aLow < hi) then
DoSort(aList, aComparer, aLow, hi);
aLow := lo;
end else begin
if (lo < aHigh) then
DoSort(aList, aComparer, lo, aHigh);
aHigh := hi;
end;
until (aLow >= aHigh);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class procedure TutlQuickSort.Sort(aList: IList; aComparer: IComparer);
begin
DoSort(aList, aComparer, 0, aList.GetCount-1);
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//TutlBinarySearch///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.DoSearch(aList: IList; aComparer: IComparer; const aMin: Integer; const aMax: Integer;
constref aItem: T; out aIndex: Integer): Boolean;
var
i, cmp: Integer;
begin
if (aMin <= aMax) then begin
i := aMin + Trunc((aMax - aMin) / 2);
cmp := aComparer.Compare(aItem, aList.GetItem(i));
if (cmp = 0) then begin
result := true;
aIndex := i;
end else if (cmp < 0) then
result := DoSearch(aList, aComparer, aMin, i-1, aItem, aIndex)
else if (cmp > 0) then
result := DoSearch(aList, aComparer, i+1, aMax, aItem, aIndex);
end else begin
result := false;
aIndex := aMin;
end;
end;

/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
class function TutlBinarySearch.Search(aList: IList; aComparer: IComparer; constref aItem: T;
out aIndex: Integer): Boolean;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
function Supports(const aInstance: TObject; const aClass: TClass; out aObj): Boolean;
begin
result := DoSearch(aList, aComparer, 0, aList.GetCount-1, aItem, aIndex);
result := Assigned(aInstance) and aInstance.InheritsFrom(aClass);
if result then
TObject(aObj) := aInstance
else
TObject(aObj) := nil;
end;

end.


+ 55
- 51
uutlExceptions.pas View File

@@ -1,103 +1,107 @@
unit uutlExceptions;

{ Package: Utils
Prefix: utl - UTiLs
Beschreibung: diese Unit enthält Definitionen für verschiedene Exceptions }

{$mode objfpc}{$H+}

interface

uses
Classes, SysUtils, syncobjs;
Classes, SysUtils;

type
EOutOfRange = class(Exception)
constructor Create(const aIndex, aMin, aMax: Integer);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
EutlException = class(Exception);

EUnknownType = class(Exception)
public
constructor Create(const aObj: TObject);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
EutlInvalidOperation = class(Exception);

EArgumentNil = class(Exception)
public
constructor Create(const aArgName: String);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
EutlOutOfRange = class(EutlException)
private
fMin: Integer;
fMax: Integer;
fIndex: Integer;

EArgument = class(Exception)
public
constructor Create(const aArg, aMsg: String);
constructor Create(const aMsg: String);
end;
EParameter = EArgument;
property Min: Integer read fMin;
property Max: Integer read fMax;
property Index: Integer read fIndex;

EFileDoesntExists = class(Exception)
public
constructor Create(const aFilename: string);
constructor Create(const aIndex, aMin, aMax: Integer);
constructor Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
end;
EFileNotFound = EFileDoesntExists;

EInvalidFile = class(Exception);
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
EutlArgument = class(EutlException)
private
fArgument: String;

EInvalidOperation = class(Exception);
public
property Argument: String read fArgument;

ENotSupported = class(Exception);
constructor Create(const aArgument: String);
constructor Create(const aMsg, aArgument: string);
end;

EWait = class(Exception)
private
fWaitResult: TWaitResult;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
EutlArgumentNil = class(EutlArgument)
public
property WaitResult: TWaitResult read fWaitResult;
constructor Create(const msg: string; const aWaitResult: TWaitResult);
constructor Create(const aArgument: String);
constructor Create(const aMsg, aArgument: string);
end;

implementation

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EOutOfRange.Create(const aIndex, aMin, aMax: Integer);
begin
inherited Create(format('index (%d) out of range (%d:%d)', [aIndex, aMin, aMax]));
end;

//EutlOutOfRange////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EUnknownType.Create(const aObj: TObject);
constructor EutlOutOfRange.Create(const aIndex, aMin, aMax: Integer);
begin
inherited Create(format('unknown type: %s', [aObj.ClassName]));
Create('', aIndex, aMin, aMax);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EArgumentNil.Create(const aArgName: String);
constructor EutlOutOfRange.Create(const aMsg: String; const aIndex, aMin, aMax: Integer);
var
s: String;
begin
inherited Create(format('argument ''%s'' can not be nil!', [aArgName]));
fIndex := aIndex;
fMin := aMin;
fMax := aMax;
s := Format('index (%d) out of range (%d:%d)', [fIndex, fMin, fMax]);
if (aMsg <> '') then
s := s + ': ' + aMsg;
inherited Create(s);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EArgument.Create(const aArg, aMsg: String);
//EutlArgument//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EutlArgument.Create(const aArgument: String);
begin
inherited Create(format('invalid argument "%s" - %s', [aArg, aMsg]))
inherited Create(aArgument + ' is not valid');
fArgument := aArgument;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EArgument.Create(const aMsg: String);
constructor EutlArgument.Create(const aMsg, aArgument: string);
begin
inherited Create(aMsg);
fArgument := aArgument;
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EFileDoesntExists.Create(const aFilename: string);
//EutlArgumentNil///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EutlArgumentNil.Create(const aArgument: String);
begin
inherited Create('file doesn''t exists: ' + aFilename);
inherited Create('argument nil: ' + aArgument, aArgument);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
constructor EWait.Create(const msg: string; const aWaitResult: TWaitResult);
constructor EutlArgumentNil.Create(const aMsg, aArgument: string);
begin
inherited Create(msg);
fWaitResult := aWaitResult;
inherited Create(aMsg, aArgument);
end;


end.


+ 912
- 1513
uutlGenerics.pas
File diff suppressed because it is too large
View File


Loading…
Cancel
Save