@@ -1,9 +1,5 @@ | |||
*.dbg | |||
lib/ | |||
*.exe | |||
*.ini | |||
*.log | |||
*.profraw | |||
*.heaptrc | |||
*lib/ | |||
*/cache* | |||
*.o | |||
*.ppu | |||
*.dbg |
@@ -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> |
@@ -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. | |||
@@ -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> |
@@ -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. | |||
@@ -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. | |||
@@ -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. | |||
@@ -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. | |||
@@ -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. | |||
@@ -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. | |||
@@ -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. | |||