mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-11-23 15:19:36 +01:00
TAChart: Add initial unit-testing infrastructure. Test TIntervalList class.
git-svn-id: trunk@26677 -
This commit is contained in:
ask
parent
1e37069221
commit
c0047f6d24
3
.gitattributes
vendored
3
.gitattributes
vendored
@ -2211,6 +2211,9 @@ components/tachart/tasubcomponentseditor.pas svneol=native#text/pascal
|
|||||||
components/tachart/tatools.pas svneol=native#text/pascal
|
components/tachart/tatools.pas svneol=native#text/pascal
|
||||||
components/tachart/tatransformations.pas svneol=native#text/pascal
|
components/tachart/tatransformations.pas svneol=native#text/pascal
|
||||||
components/tachart/tatypes.pas svneol=native#text/plain
|
components/tachart/tatypes.pas svneol=native#text/plain
|
||||||
|
components/tachart/test/UtilsTest.pas svneol=native#text/pascal
|
||||||
|
components/tachart/test/test.lpi svneol=native#text/plain
|
||||||
|
components/tachart/test/test.lpr svneol=native#text/pascal
|
||||||
components/tdbf/Makefile svneol=native#text/plain
|
components/tdbf/Makefile svneol=native#text/plain
|
||||||
components/tdbf/Makefile.fpc svneol=native#text/plain
|
components/tdbf/Makefile.fpc svneol=native#text/plain
|
||||||
components/tdbf/dbflaz.lpk svneol=native#text/pascal
|
components/tdbf/dbflaz.lpk svneol=native#text/pascal
|
||||||
|
|||||||
101
components/tachart/test/UtilsTest.pas
Normal file
101
components/tachart/test/UtilsTest.pas
Normal file
@ -0,0 +1,101 @@
|
|||||||
|
unit UtilsTest;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, FPCUnit, TestRegistry, TAChartUtils;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TIntervalListTest }
|
||||||
|
|
||||||
|
TIntervalListTest = class(TTestCase)
|
||||||
|
private
|
||||||
|
FIList: TIntervalList;
|
||||||
|
protected
|
||||||
|
procedure SetUp; override;
|
||||||
|
procedure TearDown; override;
|
||||||
|
published
|
||||||
|
procedure Basic;
|
||||||
|
procedure Intersect;
|
||||||
|
procedure Merge;
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{ TIntervalListTest }
|
||||||
|
|
||||||
|
procedure TIntervalListTest.Basic;
|
||||||
|
begin
|
||||||
|
AssertEquals(0, FIList.IntervalCount);
|
||||||
|
FIList.AddRange(1.0, 2.0);
|
||||||
|
AssertEquals(1, FIList.IntervalCount);
|
||||||
|
FIList.AddPoint(3.0);
|
||||||
|
AssertEquals(2, FIList.IntervalCount);
|
||||||
|
AssertEquals(3.0, FIList.Interval[1].FEnd);
|
||||||
|
FIList.Clear;
|
||||||
|
AssertEquals(0, FIList.IntervalCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIntervalListTest.Intersect;
|
||||||
|
var
|
||||||
|
l, r: Double;
|
||||||
|
hint: Integer = 0;
|
||||||
|
begin
|
||||||
|
FIList.Clear;
|
||||||
|
FIList.AddRange(1.0, 2.0);
|
||||||
|
l := 5.0;
|
||||||
|
r := 6.0;
|
||||||
|
AssertFalse(FIList.Intersect(l, r, hint));
|
||||||
|
l := 1.5;
|
||||||
|
r := 6.0;
|
||||||
|
AssertTrue(FIList.Intersect(l, r, hint));
|
||||||
|
AssertEquals(2.0, r);
|
||||||
|
FIList.Epsilon := 0.1;
|
||||||
|
l := 0.5;
|
||||||
|
r := 2.5;
|
||||||
|
AssertTrue(FIList.Intersect(l, r, hint));
|
||||||
|
AssertEquals(0.9, l);
|
||||||
|
AssertEquals(2.1, r);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIntervalListTest.Merge;
|
||||||
|
begin
|
||||||
|
FIList.Clear;
|
||||||
|
FIList.AddRange(1.0, 2.0);
|
||||||
|
FIList.AddRange(3.0, 4.0);
|
||||||
|
AssertEquals(2, FIList.IntervalCount);
|
||||||
|
FIList.AddRange(1.5, 2.5);
|
||||||
|
AssertEquals(2, FIList.IntervalCount);
|
||||||
|
AssertEquals(2.5, FIList.Interval[0].FEnd);
|
||||||
|
FIList.AddRange(3.5, 3.6);
|
||||||
|
AssertEquals(2, FIList.IntervalCount);
|
||||||
|
FIList.AddRange(2.5, 3.0);
|
||||||
|
AssertEquals(1, FIList.IntervalCount);
|
||||||
|
FIList.AddPoint(4.0);
|
||||||
|
AssertEquals(1, FIList.IntervalCount);
|
||||||
|
FIList.AddPoint(4.1);
|
||||||
|
AssertEquals(2, FIList.IntervalCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIntervalListTest.SetUp;
|
||||||
|
begin
|
||||||
|
inherited SetUp;
|
||||||
|
FIList := TIntervalList.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TIntervalListTest.TearDown;
|
||||||
|
begin
|
||||||
|
inherited TearDown;
|
||||||
|
FreeAndNil(FIList);
|
||||||
|
end;
|
||||||
|
|
||||||
|
initialization
|
||||||
|
|
||||||
|
RegisterTests([TIntervalListTest]);
|
||||||
|
|
||||||
|
end.
|
||||||
|
|
||||||
85
components/tachart/test/test.lpi
Normal file
85
components/tachart/test/test.lpi
Normal file
@ -0,0 +1,85 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Version Value="7"/>
|
||||||
|
<General>
|
||||||
|
<Flags>
|
||||||
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
|
<UseDefaultCompilerOptions Value="True"/>
|
||||||
|
</Flags>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<TargetFileExt Value=".exe"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<Language Value=""/>
|
||||||
|
<CharSet Value=""/>
|
||||||
|
<StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IgnoreBinaries Value="False"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="TAChartLazarusPkg"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="test.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="test"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="UtilsTest.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="UtilsTest"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="test"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)\"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Other>
|
||||||
|
<CompilerMessages>
|
||||||
|
<UseMsgFile Value="True"/>
|
||||||
|
</CompilerMessages>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</CompilerOptions>
|
||||||
|
<Debugging>
|
||||||
|
<Exceptions Count="3">
|
||||||
|
<Item1>
|
||||||
|
<Name Value="EAbort"/>
|
||||||
|
</Item1>
|
||||||
|
<Item2>
|
||||||
|
<Name Value="ECodetoolError"/>
|
||||||
|
</Item2>
|
||||||
|
<Item3>
|
||||||
|
<Name Value="EFOpenError"/>
|
||||||
|
</Item3>
|
||||||
|
</Exceptions>
|
||||||
|
</Debugging>
|
||||||
|
</CONFIG>
|
||||||
67
components/tachart/test/test.lpr
Normal file
67
components/tachart/test/test.lpr
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
program test;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Classes, SysUtils, CustApp, Interfaces,
|
||||||
|
FPCUnit, TestReport, TestRegistry, PlainTestReport, UtilsTest;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TAChartTests }
|
||||||
|
|
||||||
|
TAChartTests = class(TCustomApplication)
|
||||||
|
protected
|
||||||
|
procedure DoRun; override;
|
||||||
|
public
|
||||||
|
constructor Create(TheOwner: TComponent); override;
|
||||||
|
destructor Destroy; override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAChartTests }
|
||||||
|
|
||||||
|
procedure TAChartTests.DoRun;
|
||||||
|
var
|
||||||
|
testResult: TTestResult = nil;
|
||||||
|
writer: TPlainResultsWriter = nil;
|
||||||
|
begin
|
||||||
|
testResult := TTestResult.Create;
|
||||||
|
writer := TPlainResultsWriter.Create(nil);
|
||||||
|
try
|
||||||
|
testResult.AddListener(writer);
|
||||||
|
GetTestRegistry.Run(testResult);
|
||||||
|
writer.WriteResult(testResult);
|
||||||
|
finally
|
||||||
|
testResult.Free;
|
||||||
|
writer.Free;
|
||||||
|
end;
|
||||||
|
Terminate;
|
||||||
|
end;
|
||||||
|
|
||||||
|
constructor TAChartTests.Create(TheOwner: TComponent);
|
||||||
|
begin
|
||||||
|
inherited Create(TheOwner);
|
||||||
|
StopOnException:=True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
destructor TAChartTests.Destroy;
|
||||||
|
begin
|
||||||
|
inherited Destroy;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Application: TAChartTests;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application:=TAChartTests.Create(nil);
|
||||||
|
Application.Title:='TAChart tests';
|
||||||
|
Application.Initialize;
|
||||||
|
Application.Run;
|
||||||
|
Application.Free;
|
||||||
|
end.
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user