mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 09:06:02 +02:00
--- Merging r33947 into '.':
U packages/fcl-base/src/fpexprpars.pp U packages/fcl-base/tests/fclbase-unittests.lpi U packages/fcl-base/tests/testexprpars.pp U packages/fcl-base/tests/fclbase-unittests.pp --- Recording mergeinfo for merge of r33947 into '.': U . --- Merging r33986 into '.': G packages/fcl-base/src/fpexprpars.pp --- Recording mergeinfo for merge of r33986 into '.': G . --- Merging r34377 into '.': G packages/fcl-base/src/fpexprpars.pp G packages/fcl-base/tests/testexprpars.pp --- Recording mergeinfo for merge of r34377 into '.': G . --- Merging r34422 into '.': G packages/fcl-base/tests/testexprpars.pp G packages/fcl-base/src/fpexprpars.pp --- Recording mergeinfo for merge of r34422 into '.': G . --- Merging r34423 into '.': G packages/fcl-base/src/fpexprpars.pp G packages/fcl-base/tests/testexprpars.pp --- Recording mergeinfo for merge of r34423 into '.': G . --- Merging r34967 into '.': G packages/fcl-base/tests/testexprpars.pp G packages/fcl-base/src/fpexprpars.pp --- Recording mergeinfo for merge of r34967 into '.': G . --- Merging r35006 into '.': G packages/fcl-base/src/fpexprpars.pp --- Recording mergeinfo for merge of r35006 into '.': G . # revisions: 33947,33986,34377,34422,34423,34967,35006 git-svn-id: branches/fixes_3_0@36537 -
This commit is contained in:
parent
5a66cefc57
commit
6e54b04036
File diff suppressed because it is too large
Load Diff
@ -1,4 +1,4 @@
|
|||||||
<?xml version="1.0"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
<CONFIG>
|
<CONFIG>
|
||||||
<ProjectOptions>
|
<ProjectOptions>
|
||||||
<Version Value="9"/>
|
<Version Value="9"/>
|
||||||
@ -6,7 +6,6 @@
|
|||||||
<Flags>
|
<Flags>
|
||||||
<MainUnitHasCreateFormStatements Value="False"/>
|
<MainUnitHasCreateFormStatements Value="False"/>
|
||||||
<MainUnitHasTitleStatement Value="False"/>
|
<MainUnitHasTitleStatement Value="False"/>
|
||||||
<UseDefaultCompilerOptions Value="True"/>
|
|
||||||
</Flags>
|
</Flags>
|
||||||
<SessionStorage Value="InProjectDir"/>
|
<SessionStorage Value="InProjectDir"/>
|
||||||
<MainUnit Value="0"/>
|
<MainUnit Value="0"/>
|
||||||
@ -31,35 +30,35 @@
|
|||||||
<RunParams>
|
<RunParams>
|
||||||
<local>
|
<local>
|
||||||
<FormatVersion Value="1"/>
|
<FormatVersion Value="1"/>
|
||||||
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
<CommandLineParams Value="--suite=TTestParserVariables.TestVariable31"/>
|
||||||
</local>
|
</local>
|
||||||
</RunParams>
|
</RunParams>
|
||||||
<Units Count="2">
|
<Units Count="3">
|
||||||
<Unit0>
|
<Unit0>
|
||||||
<Filename Value="fclbase-unittests.pp"/>
|
<Filename Value="fclbase-unittests.pp"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="fclbase_unittests"/>
|
||||||
</Unit0>
|
</Unit0>
|
||||||
<Unit1>
|
<Unit1>
|
||||||
<Filename Value="tchashlist.pp"/>
|
<Filename Value="tchashlist.pp"/>
|
||||||
<IsPartOfProject Value="True"/>
|
<IsPartOfProject Value="True"/>
|
||||||
<UnitName Value="tchashlist"/>
|
|
||||||
</Unit1>
|
</Unit1>
|
||||||
|
<Unit2>
|
||||||
|
<Filename Value="testexprpars.pp"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
</Unit2>
|
||||||
</Units>
|
</Units>
|
||||||
</ProjectOptions>
|
</ProjectOptions>
|
||||||
<CompilerOptions>
|
<CompilerOptions>
|
||||||
<Version Value="11"/>
|
<Version Value="11"/>
|
||||||
<Target>
|
<Target>
|
||||||
<Filename Value="project1"/>
|
<Filename Value="fclbase-unittests"/>
|
||||||
</Target>
|
</Target>
|
||||||
<SearchPaths>
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<OtherUnitFiles Value="../src"/>
|
||||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||||
</SearchPaths>
|
</SearchPaths>
|
||||||
<Other>
|
|
||||||
<CompilerMessages>
|
|
||||||
<MsgFileName Value=""/>
|
|
||||||
</CompilerMessages>
|
|
||||||
<CompilerPath Value="$(CompPath)"/>
|
|
||||||
</Other>
|
|
||||||
</CompilerOptions>
|
</CompilerOptions>
|
||||||
<Debugging>
|
<Debugging>
|
||||||
<Exceptions Count="3">
|
<Exceptions Count="3">
|
||||||
|
@ -10,6 +10,8 @@ var
|
|||||||
Application: TTestRunner;
|
Application: TTestRunner;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
|
DefaultFormat:=fPlain;
|
||||||
|
DefaultRunAllTests:=True;
|
||||||
Application := TTestRunner.Create(nil);
|
Application := TTestRunner.Create(nil);
|
||||||
Application.Initialize;
|
Application.Initialize;
|
||||||
Application.Title := 'FCL-Base unittests';
|
Application.Title := 'FCL-Base unittests';
|
||||||
|
@ -20,7 +20,7 @@ unit testexprpars;
|
|||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars;
|
Classes, SysUtils, fpcunit, testutils, testregistry, math, fpexprpars;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
|
||||||
@ -31,6 +31,7 @@ type
|
|||||||
FP : TFPExpressionScanner;
|
FP : TFPExpressionScanner;
|
||||||
FInvalidString : String;
|
FInvalidString : String;
|
||||||
procedure DoInvalidNumber(AString: String);
|
procedure DoInvalidNumber(AString: String);
|
||||||
|
procedure TestIdentifier(const ASource, ATokenName: string);
|
||||||
procedure TestInvalidNumber;
|
procedure TestInvalidNumber;
|
||||||
protected
|
protected
|
||||||
procedure SetUp; override;
|
procedure SetUp; override;
|
||||||
@ -46,6 +47,7 @@ type
|
|||||||
Procedure TestInvalidCharacter;
|
Procedure TestInvalidCharacter;
|
||||||
Procedure TestUnterminatedString;
|
Procedure TestUnterminatedString;
|
||||||
Procedure TestQuotesInString;
|
Procedure TestQuotesInString;
|
||||||
|
Procedure TestIdentifiers;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TMyFPExpressionParser }
|
{ TMyFPExpressionParser }
|
||||||
@ -412,6 +414,27 @@ type
|
|||||||
Procedure TestAsString;
|
Procedure TestAsString;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TTestPowerNode }
|
||||||
|
|
||||||
|
TTestPowerNode = Class(TTestBaseParser)
|
||||||
|
Private
|
||||||
|
FN : TFPPowerOperation;
|
||||||
|
FE : TFPExpressionParser;
|
||||||
|
Protected
|
||||||
|
Procedure Setup; override;
|
||||||
|
Procedure TearDown; override;
|
||||||
|
procedure Calc(AExpr: String; Expected: Double = NaN);
|
||||||
|
Published
|
||||||
|
Procedure TestCreateInteger;
|
||||||
|
Procedure TestCreateFloat;
|
||||||
|
Procedure TestCreateDateTime;
|
||||||
|
Procedure TestCreateString;
|
||||||
|
Procedure TestCreateBoolean;
|
||||||
|
Procedure TestDestroy;
|
||||||
|
Procedure TestAsString;
|
||||||
|
Procedure TestCalc;
|
||||||
|
end;
|
||||||
|
|
||||||
{ TTestDivideNode }
|
{ TTestDivideNode }
|
||||||
|
|
||||||
TTestDivideNode = Class(TTestBaseParser)
|
TTestDivideNode = Class(TTestBaseParser)
|
||||||
@ -701,6 +724,12 @@ type
|
|||||||
TTestParserVariables = Class(TTestExpressionParser)
|
TTestParserVariables = Class(TTestExpressionParser)
|
||||||
private
|
private
|
||||||
FAsWrongType : TResultType;
|
FAsWrongType : TResultType;
|
||||||
|
FEventName: String;
|
||||||
|
FBoolValue : Boolean;
|
||||||
|
FTest33 : TFPExprIdentifierDef;
|
||||||
|
procedure DoGetBooleanVar(var Res: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
|
procedure DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
|
procedure DoTestVariable33;
|
||||||
procedure TestAccess(Skip: TResultType);
|
procedure TestAccess(Skip: TResultType);
|
||||||
Protected
|
Protected
|
||||||
procedure AddVariabletwice;
|
procedure AddVariabletwice;
|
||||||
@ -741,6 +770,10 @@ type
|
|||||||
procedure TestVariable28;
|
procedure TestVariable28;
|
||||||
procedure TestVariable29;
|
procedure TestVariable29;
|
||||||
procedure TestVariable30;
|
procedure TestVariable30;
|
||||||
|
procedure TestVariable31;
|
||||||
|
procedure TestVariable32;
|
||||||
|
procedure TestVariable33;
|
||||||
|
procedure TestVariable34;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TTestParserFunctions }
|
{ TTestParserFunctions }
|
||||||
@ -782,6 +815,45 @@ type
|
|||||||
procedure TestFunction29;
|
procedure TestFunction29;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{ TAggregateNode }
|
||||||
|
|
||||||
|
TAggregateNode = Class(TFPExprNode)
|
||||||
|
Public
|
||||||
|
InitCount : Integer;
|
||||||
|
UpdateCount : Integer;
|
||||||
|
Class Function IsAggregate: Boolean; override;
|
||||||
|
Function NodeType: TResultType; override;
|
||||||
|
Procedure InitAggregate; override;
|
||||||
|
Procedure UpdateAggregate; override;
|
||||||
|
procedure GetNodeValue(var Result: TFPExpressionResult); override;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TTestParserAggregate }
|
||||||
|
|
||||||
|
TTestParserAggregate = Class(TTestExpressionParser)
|
||||||
|
private
|
||||||
|
FVarValue : Integer;
|
||||||
|
FLeft : TAggregateNode;
|
||||||
|
FRight : TAggregateNode;
|
||||||
|
FFunction : TFPExprIdentifierDef;
|
||||||
|
FFunction2 : TFPExprIdentifierDef;
|
||||||
|
Protected
|
||||||
|
Procedure Setup; override;
|
||||||
|
Procedure TearDown; override;
|
||||||
|
public
|
||||||
|
procedure GetVar(var Result: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
|
Published
|
||||||
|
Procedure TestIsAggregate;
|
||||||
|
Procedure TestHasAggregate;
|
||||||
|
Procedure TestBinaryAggregate;
|
||||||
|
Procedure TestUnaryAggregate;
|
||||||
|
Procedure TestCountAggregate;
|
||||||
|
Procedure TestSumAggregate;
|
||||||
|
Procedure TestSumAggregate2;
|
||||||
|
Procedure TestAvgAggregate;
|
||||||
|
Procedure TestAvgAggregate2;
|
||||||
|
Procedure TestAvgAggregate3;
|
||||||
|
end;
|
||||||
{ TTestBuiltinsManager }
|
{ TTestBuiltinsManager }
|
||||||
|
|
||||||
TTestBuiltinsManager = Class(TTestExpressionParser)
|
TTestBuiltinsManager = Class(TTestExpressionParser)
|
||||||
@ -804,8 +876,11 @@ type
|
|||||||
|
|
||||||
TTestBuiltins = Class(TTestExpressionParser)
|
TTestBuiltins = Class(TTestExpressionParser)
|
||||||
private
|
private
|
||||||
|
FValue : Integer;
|
||||||
FM : TExprBuiltInManager;
|
FM : TExprBuiltInManager;
|
||||||
FExpr : String;
|
FExpr : String;
|
||||||
|
procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
|
||||||
|
procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
Protected
|
Protected
|
||||||
procedure Setup; override;
|
procedure Setup; override;
|
||||||
procedure Teardown; override;
|
procedure Teardown; override;
|
||||||
@ -817,6 +892,8 @@ type
|
|||||||
procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
|
procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
|
||||||
procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
|
procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
|
||||||
procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
|
procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
|
||||||
|
procedure AssertAggregateExpression(Const AExpression : String; AResult : Int64; AUpdateCount : integer);
|
||||||
|
procedure AssertAggregateExpression(Const AExpression : String; AResult : TExprFloat; AUpdateCount : integer);
|
||||||
Published
|
Published
|
||||||
procedure TestRegister;
|
procedure TestRegister;
|
||||||
Procedure TestVariablepi;
|
Procedure TestVariablepi;
|
||||||
@ -883,12 +960,337 @@ type
|
|||||||
Procedure TestFunctionstrtotimedef;
|
Procedure TestFunctionstrtotimedef;
|
||||||
Procedure TestFunctionstrtodatetime;
|
Procedure TestFunctionstrtodatetime;
|
||||||
Procedure TestFunctionstrtodatetimedef;
|
Procedure TestFunctionstrtodatetimedef;
|
||||||
|
Procedure TestFunctionAggregateSum;
|
||||||
|
Procedure TestFunctionAggregateCount;
|
||||||
|
Procedure TestFunctionAggregateAvg;
|
||||||
|
Procedure TestFunctionAggregateMin;
|
||||||
|
Procedure TestFunctionAggregateMax;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses typinfo;
|
uses typinfo;
|
||||||
|
|
||||||
|
{ TTestParserAggregate }
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.Setup;
|
||||||
|
begin
|
||||||
|
inherited Setup;
|
||||||
|
FVarValue:=0;
|
||||||
|
FFunction:=TFPExprIdentifierDef.Create(Nil);
|
||||||
|
FFunction.Name:='Count';
|
||||||
|
FFunction2:=TFPExprIdentifierDef.Create(Nil);
|
||||||
|
FFunction2.Name:='MyVar';
|
||||||
|
FFunction2.ResultType:=rtInteger;
|
||||||
|
FFunction2.IdentifierType:=itVariable;
|
||||||
|
FFunction2.OnGetVariableValue:=@GetVar;
|
||||||
|
FLeft:=TAggregateNode.Create;
|
||||||
|
FRight:=TAggregateNode.Create;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TearDown;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FFunction);
|
||||||
|
FreeAndNil(FLeft);
|
||||||
|
FreeAndNil(FRight);
|
||||||
|
inherited TearDown;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.GetVar(var Result: TFPExpressionResult; ConstRef
|
||||||
|
AName: ShortString);
|
||||||
|
begin
|
||||||
|
Result.ResultType:=FFunction2.ResultType;
|
||||||
|
Case Result.ResultType of
|
||||||
|
rtInteger : Result.ResInteger:=FVarValue;
|
||||||
|
rtFloat : Result.ResFloat:=FVarValue / 2;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestIsAggregate;
|
||||||
|
begin
|
||||||
|
AssertEquals('ExprNode',False,TFPExprNode.IsAggregate);
|
||||||
|
AssertEquals('TAggregateExpr',True,TAggregateExpr.IsAggregate);
|
||||||
|
AssertEquals('TAggregateExpr',False,TFPBinaryOperation.IsAggregate);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestHasAggregate;
|
||||||
|
|
||||||
|
Var
|
||||||
|
N : TFPExprNode;
|
||||||
|
|
||||||
|
begin
|
||||||
|
N:=TFPExprNode.Create;
|
||||||
|
try
|
||||||
|
AssertEquals('ExprNode',False,N.HasAggregate);
|
||||||
|
finally
|
||||||
|
N.Free;
|
||||||
|
end;
|
||||||
|
N:=TAggregateExpr.Create;
|
||||||
|
try
|
||||||
|
AssertEquals('ExprNode',True,N.HasAggregate);
|
||||||
|
finally
|
||||||
|
N.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestBinaryAggregate;
|
||||||
|
|
||||||
|
Var
|
||||||
|
B : TFPBinaryOperation;
|
||||||
|
|
||||||
|
begin
|
||||||
|
B:=TFPBinaryOperation.Create(Fleft,TFPConstExpression.CreateInteger(1));
|
||||||
|
try
|
||||||
|
FLeft:=Nil;
|
||||||
|
AssertEquals('Binary',True,B.HasAggregate);
|
||||||
|
finally
|
||||||
|
B.Free;
|
||||||
|
end;
|
||||||
|
B:=TFPBinaryOperation.Create(TFPConstExpression.CreateInteger(1),FRight);
|
||||||
|
try
|
||||||
|
FRight:=Nil;
|
||||||
|
AssertEquals('Binary',True,B.HasAggregate);
|
||||||
|
finally
|
||||||
|
B.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestUnaryAggregate;
|
||||||
|
Var
|
||||||
|
B : TFPUnaryOperator;
|
||||||
|
|
||||||
|
begin
|
||||||
|
B:=TFPUnaryOperator.Create(Fleft);
|
||||||
|
try
|
||||||
|
FLeft:=Nil;
|
||||||
|
AssertEquals('Unary',True,B.HasAggregate);
|
||||||
|
finally
|
||||||
|
B.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestCountAggregate;
|
||||||
|
|
||||||
|
Var
|
||||||
|
C : TAggregateCount;
|
||||||
|
I : Integer;
|
||||||
|
R : TFPExpressionResult;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFunction.ResultType:=rtInteger;
|
||||||
|
FFunction.ParameterTypes:='';
|
||||||
|
C:=TAggregateCount.CreateFunction(FFunction,Nil);
|
||||||
|
try
|
||||||
|
C.Check;
|
||||||
|
C.InitAggregate;
|
||||||
|
For I:=1 to 11 do
|
||||||
|
C.UpdateAggregate;
|
||||||
|
C.GetNodeValue(R);
|
||||||
|
AssertEquals('Correct type',rtInteger,R.ResultType);
|
||||||
|
AssertEquals('Correct value',11,R.ResInteger);
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestSumAggregate;
|
||||||
|
|
||||||
|
Var
|
||||||
|
C : TAggregateSum;
|
||||||
|
V : TFPExprVariable;
|
||||||
|
I : Integer;
|
||||||
|
R : TFPExpressionResult;
|
||||||
|
A : TExprArgumentArray;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFunction.ResultType:=rtInteger;
|
||||||
|
FFunction.ParameterTypes:='I';
|
||||||
|
FFunction.Name:='SUM';
|
||||||
|
FFunction2.ResultType:=rtInteger;
|
||||||
|
C:=Nil;
|
||||||
|
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||||
|
try
|
||||||
|
SetLength(A,1);
|
||||||
|
A[0]:=V;
|
||||||
|
C:=TAggregateSum.CreateFunction(FFunction,A);
|
||||||
|
C.Check;
|
||||||
|
C.InitAggregate;
|
||||||
|
For I:=1 to 10 do
|
||||||
|
begin
|
||||||
|
FVarValue:=I;
|
||||||
|
C.UpdateAggregate;
|
||||||
|
end;
|
||||||
|
C.GetNodeValue(R);
|
||||||
|
AssertEquals('Correct type',rtInteger,R.ResultType);
|
||||||
|
AssertEquals('Correct value',55,R.ResInteger);
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestSumAggregate2;
|
||||||
|
Var
|
||||||
|
C : TAggregateSum;
|
||||||
|
V : TFPExprVariable;
|
||||||
|
I : Integer;
|
||||||
|
R : TFPExpressionResult;
|
||||||
|
A : TExprArgumentArray;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFunction.ResultType:=rtFloat;
|
||||||
|
FFunction.ParameterTypes:='F';
|
||||||
|
FFunction.Name:='SUM';
|
||||||
|
FFunction2.ResultType:=rtFloat;
|
||||||
|
C:=Nil;
|
||||||
|
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||||
|
try
|
||||||
|
SetLength(A,1);
|
||||||
|
A[0]:=V;
|
||||||
|
C:=TAggregateSum.CreateFunction(FFunction,A);
|
||||||
|
C.Check;
|
||||||
|
C.InitAggregate;
|
||||||
|
For I:=1 to 10 do
|
||||||
|
begin
|
||||||
|
FVarValue:=I;
|
||||||
|
C.UpdateAggregate;
|
||||||
|
end;
|
||||||
|
C.GetNodeValue(R);
|
||||||
|
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||||
|
AssertEquals('Correct value',55/2,R.ResFloat,0.1);
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestAvgAggregate;
|
||||||
|
|
||||||
|
Var
|
||||||
|
C : TAggregateAvg;
|
||||||
|
V : TFPExprVariable;
|
||||||
|
I : Integer;
|
||||||
|
R : TFPExpressionResult;
|
||||||
|
A : TExprArgumentArray;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFunction.ResultType:=rtInteger;
|
||||||
|
FFunction.ParameterTypes:='F';
|
||||||
|
FFunction.Name:='AVG';
|
||||||
|
FFunction2.ResultType:=rtInteger;
|
||||||
|
C:=Nil;
|
||||||
|
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||||
|
try
|
||||||
|
SetLength(A,1);
|
||||||
|
A[0]:=V;
|
||||||
|
C:=TAggregateAvg.CreateFunction(FFunction,A);
|
||||||
|
C.Check;
|
||||||
|
C.InitAggregate;
|
||||||
|
For I:=1 to 10 do
|
||||||
|
begin
|
||||||
|
FVarValue:=I;
|
||||||
|
C.UpdateAggregate;
|
||||||
|
end;
|
||||||
|
C.GetNodeValue(R);
|
||||||
|
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||||
|
AssertEquals('Correct value',5.5,R.ResFloat,0.1);
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestAvgAggregate2;
|
||||||
|
|
||||||
|
Var
|
||||||
|
C : TAggregateAvg;
|
||||||
|
V : TFPExprVariable;
|
||||||
|
I : Integer;
|
||||||
|
R : TFPExpressionResult;
|
||||||
|
A : TExprArgumentArray;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFunction.ResultType:=rtInteger;
|
||||||
|
FFunction.ParameterTypes:='F';
|
||||||
|
FFunction.Name:='AVG';
|
||||||
|
FFunction2.ResultType:=rtFloat;
|
||||||
|
C:=Nil;
|
||||||
|
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||||
|
try
|
||||||
|
SetLength(A,1);
|
||||||
|
A[0]:=V;
|
||||||
|
C:=TAggregateAvg.CreateFunction(FFunction,A);
|
||||||
|
C.Check;
|
||||||
|
C.InitAggregate;
|
||||||
|
For I:=1 to 10 do
|
||||||
|
begin
|
||||||
|
FVarValue:=I;
|
||||||
|
C.UpdateAggregate;
|
||||||
|
end;
|
||||||
|
C.GetNodeValue(R);
|
||||||
|
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||||
|
AssertEquals('Correct value',5.5/2,R.ResFloat,0.1);
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserAggregate.TestAvgAggregate3;
|
||||||
|
Var
|
||||||
|
C : TAggregateAvg;
|
||||||
|
V : TFPExprVariable;
|
||||||
|
I : Integer;
|
||||||
|
R : TFPExpressionResult;
|
||||||
|
A : TExprArgumentArray;
|
||||||
|
|
||||||
|
begin
|
||||||
|
FFunction.ResultType:=rtInteger;
|
||||||
|
FFunction.ParameterTypes:='F';
|
||||||
|
FFunction.Name:='AVG';
|
||||||
|
FFunction2.ResultType:=rtFloat;
|
||||||
|
C:=Nil;
|
||||||
|
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||||
|
try
|
||||||
|
SetLength(A,1);
|
||||||
|
A[0]:=V;
|
||||||
|
C:=TAggregateAvg.CreateFunction(FFunction,A);
|
||||||
|
C.Check;
|
||||||
|
C.InitAggregate;
|
||||||
|
C.GetNodeValue(R);
|
||||||
|
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||||
|
AssertEquals('Correct value',0.0,R.ResFloat,0.1);
|
||||||
|
finally
|
||||||
|
C.Free;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
{ TAggregateNode }
|
||||||
|
|
||||||
|
class function TAggregateNode.IsAggregate: Boolean;
|
||||||
|
begin
|
||||||
|
Result:=True
|
||||||
|
end;
|
||||||
|
|
||||||
|
function TAggregateNode.NodeType: TResultType;
|
||||||
|
begin
|
||||||
|
Result:=rtInteger;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAggregateNode.InitAggregate;
|
||||||
|
begin
|
||||||
|
inherited InitAggregate;
|
||||||
|
inc(InitCount)
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAggregateNode.UpdateAggregate;
|
||||||
|
begin
|
||||||
|
inherited UpdateAggregate;
|
||||||
|
inc(UpdateCount);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TAggregateNode.GetNodeValue(var Result: TFPExpressionResult);
|
||||||
|
begin
|
||||||
|
Result.ResultType:=rtInteger;
|
||||||
|
Result.ResInteger:=updateCount;
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTestExpressionScanner.TestCreate;
|
procedure TTestExpressionScanner.TestCreate;
|
||||||
begin
|
begin
|
||||||
AssertEquals('Empty source','',FP.Source);
|
AssertEquals('Empty source','',FP.Source);
|
||||||
@ -921,7 +1323,7 @@ Const
|
|||||||
= ('+','-','<','>','=','/',
|
= ('+','-','<','>','=','/',
|
||||||
'*','(',')','<=','>=',
|
'*','(',')','<=','>=',
|
||||||
'<>','1','''abc''','abc',',','and',
|
'<>','1','''abc''','abc',',','and',
|
||||||
'or','xor','true','false','not','if','case','');
|
'or','xor','true','false','not','if','case','^','');
|
||||||
|
|
||||||
var
|
var
|
||||||
t : TTokenType;
|
t : TTokenType;
|
||||||
@ -941,28 +1343,27 @@ procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
|
|||||||
|
|
||||||
begin
|
begin
|
||||||
FInvalidString:=AString;
|
FInvalidString:=AString;
|
||||||
AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber);
|
AssertException('Invalid number "'+AString+'" ',EExprScanner,@TestInvalidNumber);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestExpressionScanner.TestNumber;
|
procedure TTestExpressionScanner.TestNumber;
|
||||||
begin
|
begin
|
||||||
TestString('123',ttNumber);
|
{TestString('123',ttNumber);
|
||||||
TestString('123.4',ttNumber);
|
TestString('123.4',ttNumber);
|
||||||
TestString('123.E4',ttNumber);
|
TestString('123.E4',ttNumber);
|
||||||
TestString('1.E4',ttNumber);
|
TestString('1.E4',ttNumber);
|
||||||
TestString('1e-2',ttNumber);
|
TestString('1e-2',ttNumber);
|
||||||
DoInvalidNumber('1..1');
|
DoInvalidNumber('1..1');
|
||||||
|
}
|
||||||
DoInvalidNumber('1.E--1');
|
DoInvalidNumber('1.E--1');
|
||||||
DoInvalidNumber('.E-1');
|
// DoInvalidNumber('.E-1');
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestExpressionScanner.TestInvalidCharacter;
|
procedure TTestExpressionScanner.TestInvalidCharacter;
|
||||||
begin
|
begin
|
||||||
DoInvalidNumber('~');
|
DoInvalidNumber('~');
|
||||||
DoInvalidNumber('^');
|
|
||||||
DoInvalidNumber('#');
|
DoInvalidNumber('#');
|
||||||
DoInvalidNumber('$');
|
DoInvalidNumber('$');
|
||||||
DoInvalidNumber('^');
|
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestExpressionScanner.TestUnterminatedString;
|
procedure TTestExpressionScanner.TestUnterminatedString;
|
||||||
@ -977,6 +1378,27 @@ begin
|
|||||||
TestString('''s it''''''',ttString);
|
TestString('''s it''''''',ttString);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestExpressionScanner.TestIdentifier(Const ASource,ATokenName : string);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FP.Source:=ASource;
|
||||||
|
AssertEquals('Token type',ttIdentifier,FP.GetToken);
|
||||||
|
AssertEquals('Token name',ATokenName,FP.Token);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestExpressionScanner.TestIdentifiers;
|
||||||
|
begin
|
||||||
|
TestIdentifier('a','a');
|
||||||
|
TestIdentifier(' a','a');
|
||||||
|
TestIdentifier('a ','a');
|
||||||
|
TestIdentifier('a^b','a');
|
||||||
|
TestIdentifier('a-b','a');
|
||||||
|
TestIdentifier('a.b','a.b');
|
||||||
|
TestIdentifier('"a b"','a b');
|
||||||
|
TestIdentifier('c."a b"','c.a b');
|
||||||
|
TestIdentifier('c."ab"','c.ab');
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTestExpressionScanner.SetUp;
|
procedure TTestExpressionScanner.SetUp;
|
||||||
begin
|
begin
|
||||||
FP:=TFPExpressionScanner.Create;
|
FP:=TFPExpressionScanner.Create;
|
||||||
@ -1118,15 +1540,16 @@ end;
|
|||||||
procedure TTestConstExprNode.TestCreateFloat;
|
procedure TTestConstExprNode.TestCreateFloat;
|
||||||
|
|
||||||
Var
|
Var
|
||||||
S : String;
|
F : Double;
|
||||||
|
C : Integer;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
FN:=TFPConstExpression.CreateFloat(2.34);
|
FN:=TFPConstExpression.CreateFloat(2.34);
|
||||||
AssertEquals('Correct type',rtFloat,FN.NodeType);
|
AssertEquals('Correct type',rtFloat,FN.NodeType);
|
||||||
AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
|
AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
|
||||||
AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
|
AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
|
||||||
Str(TExprFLoat(2.34),S);
|
Val(FN.AsString,F,C);
|
||||||
AssertEquals('AsString ok',S,FN.AsString);
|
AssertEquals('AsString ok',2.34,F,0.001);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestConstExprNode.TestCreateBoolean;
|
procedure TTestConstExprNode.TestCreateBoolean;
|
||||||
@ -2026,6 +2449,130 @@ begin
|
|||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TTestPowerNode }
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TearDown;
|
||||||
|
begin
|
||||||
|
FreeAndNil(FN);
|
||||||
|
inherited TearDown;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.Setup;
|
||||||
|
begin
|
||||||
|
inherited ;
|
||||||
|
FE:=TFpExpressionParser.Create(Nil);
|
||||||
|
FE.Builtins := [bcMath];
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.Calc(AExpr: String; Expected: Double =NaN);
|
||||||
|
const
|
||||||
|
EPS = 1e-9;
|
||||||
|
var
|
||||||
|
res: TFpExpressionResult;
|
||||||
|
x: Double;
|
||||||
|
begin
|
||||||
|
FE.Expression := AExpr;
|
||||||
|
res:=FE.Evaluate;
|
||||||
|
x:= ArgToFloat(res);
|
||||||
|
if not IsNaN(Expected) then
|
||||||
|
AssertEquals('Expression '+AExpr+' result',Expected,X,Eps);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestCalc;
|
||||||
|
|
||||||
|
begin
|
||||||
|
Calc('2^2', Power(2, 2));
|
||||||
|
Calc('2^-2', Power(2, -2));
|
||||||
|
Calc('2^(-2)', Power(2, -2));
|
||||||
|
Calc('sqrt(3)^2', Power(sqrt(3), 2));
|
||||||
|
Calc('-sqrt(3)^2', -Power(sqrt(3), 2));
|
||||||
|
Calc('-2^2', -Power(2, 2));
|
||||||
|
Calc('(-2.0)^2', Power(-2.0, 2));
|
||||||
|
Calc('(-2.0)^-2', Power(-2.0, -2));
|
||||||
|
// Odd integer exponent
|
||||||
|
Calc('2^3', Power(2, 3));
|
||||||
|
Calc('-2^3', -Power(2, 3));
|
||||||
|
Calc('-2^-3', -Power(2, -3));
|
||||||
|
Calc('-2^(-3)', -Power(2, -3));
|
||||||
|
Calc('(-2.0)^3', Power(-2.0, 3));
|
||||||
|
Calc('(-2.0)^-3', Power(-2.0, -3));
|
||||||
|
// Fractional exponent
|
||||||
|
Calc('10^2.5', power(10, 2.5));
|
||||||
|
Calc('10^-2.5', Power(10, -2.5));
|
||||||
|
// Expressions
|
||||||
|
Calc('(1+1)^3', Power(1+1, 3));
|
||||||
|
Calc('1+2^3', 1 + Power(2, 3));
|
||||||
|
calc('2^3+1', Power(2, 3) + 1);
|
||||||
|
Calc('2^3*2', Power(2, 3) * 2);
|
||||||
|
Calc('2^3*-2', Power(2, 3) * -2);
|
||||||
|
Calc('2^(1+1)', Power(2, 1+1));
|
||||||
|
Calc('2^-(1+1)', Power(2, -(1+1)));
|
||||||
|
WriteLn;
|
||||||
|
// Special cases
|
||||||
|
Calc('0^0', power(0, 0));
|
||||||
|
calc('0^1', power(0, 1));
|
||||||
|
Calc('0^2.5', Power(0, 2.5));
|
||||||
|
calc('2.5^0', power(2.5, 0));
|
||||||
|
calc('2^3^4', 2417851639229258349412352); // according to Wolfram Alpha, 2^(3^4)
|
||||||
|
|
||||||
|
// These expressions should throw expections
|
||||||
|
|
||||||
|
//Calc('(-10)^2.5', NaN); // base must be positive in case of fractional exponent
|
||||||
|
//Calc('0^-2', NaN); // is 1/0^2 = 1/0
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestCreateInteger;
|
||||||
|
begin
|
||||||
|
FN:=TFPPowerOperation.Create(CreateIntNode(4),CreateIntNode(2));
|
||||||
|
AssertEquals('Power has correct type',rtfloat,FN.NodeType);
|
||||||
|
AssertEquals('Power has correct result',16.0,FN.NodeValue.ResFloat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestCreateFloat;
|
||||||
|
begin
|
||||||
|
FN:=TFPPowerOperation.Create(CreateFloatNode(2.0),CreateFloatNode(3.0));
|
||||||
|
AssertEquals('Power has correct type',rtFloat,FN.NodeType);
|
||||||
|
AssertEquals('Power has correct result',8.0,FN.NodeValue.ResFloat);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestCreateDateTime;
|
||||||
|
|
||||||
|
Var
|
||||||
|
D,T : TDateTime;
|
||||||
|
|
||||||
|
begin
|
||||||
|
D:=Date;
|
||||||
|
T:=Time;
|
||||||
|
FN:=TFPPowerOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
|
||||||
|
AssertNodeNotOK('No datetime Power',FN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestCreateString;
|
||||||
|
begin
|
||||||
|
FN:=TFPPowerOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
|
||||||
|
AssertNodeNotOK('No string Power',FN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestCreateBoolean;
|
||||||
|
begin
|
||||||
|
FN:=TFPPowerOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
|
||||||
|
AssertNodeNotOK('No boolean Power',FN);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestDestroy;
|
||||||
|
begin
|
||||||
|
FN:=TFPPowerOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
|
||||||
|
FreeAndNil(FN);
|
||||||
|
AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestPowerNode.TestAsString;
|
||||||
|
begin
|
||||||
|
FN:=TFPPowerOperation.Create(CreateIntNode(1),CreateIntNode(2));
|
||||||
|
AssertEquals('Asstring works ok','1^2',FN.AsString);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{ TTestDivideNode }
|
{ TTestDivideNode }
|
||||||
|
|
||||||
procedure TTestDivideNode.TearDown;
|
procedure TTestDivideNode.TearDown;
|
||||||
@ -4196,6 +4743,114 @@ begin
|
|||||||
AssertEquals('Correct value',False,I.AsBoolean);
|
AssertEquals('Correct value',False,I.AsBoolean);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.DoGetBooleanVar(var Res: TFPExpressionResult;
|
||||||
|
ConstRef AName: ShortString);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FEventName:=AName;
|
||||||
|
Res.ResBoolean:=FBoolValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.TestVariable31;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : TFPExprIdentifierDef;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar);
|
||||||
|
AssertEquals('Correct name','a',i.Name);
|
||||||
|
AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
|
||||||
|
AssertSame(TMethod(I.OnGetVariableValue).Code,TMethod(@DoGetBooleanVar).Code);
|
||||||
|
FBoolValue:=True;
|
||||||
|
FEventName:='';
|
||||||
|
AssertEquals('Correct value 1',True,I.AsBoolean);
|
||||||
|
AssertEquals('Correct name passed','a',FEventName);
|
||||||
|
FBoolValue:=False;
|
||||||
|
FEventName:='';
|
||||||
|
AssertEquals('Correct value 2',False,I.AsBoolean);
|
||||||
|
AssertEquals('Correct name passed','a',FEventName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
Var
|
||||||
|
FVarCallBackName:String;
|
||||||
|
FVarBoolValue : Boolean;
|
||||||
|
|
||||||
|
procedure DoGetBooleanVar2(var Res: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FVarCallBackName:=AName;
|
||||||
|
Res.ResBoolean:=FVarBoolValue;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FEventName:=AName;
|
||||||
|
Res.ResultType:=rtInteger;
|
||||||
|
Res.ResInteger:=33;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.TestVariable32;
|
||||||
|
Var
|
||||||
|
I : TFPExprIdentifierDef;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2);
|
||||||
|
AssertEquals('Correct name','a',i.Name);
|
||||||
|
AssertEquals('Correct type',Ord(rtBoolean),Ord(i.ResultType));
|
||||||
|
AssertSame(I.OnGetVariableValueCallBack,@DoGetBooleanVar2);
|
||||||
|
FVarBoolValue:=True;
|
||||||
|
FVarCallBackName:='';
|
||||||
|
AssertEquals('Correct value 1',True,I.AsBoolean);
|
||||||
|
AssertEquals('Correct name passed','a',FVarCallBackName);
|
||||||
|
FVarBoolValue:=False;
|
||||||
|
FVarCallBackName:='';
|
||||||
|
AssertEquals('Correct value 2',False,I.AsBoolean);
|
||||||
|
AssertEquals('Correct name passed','a',FVarCallBackName);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.DoTestVariable33;
|
||||||
|
|
||||||
|
Var
|
||||||
|
B : Boolean;
|
||||||
|
|
||||||
|
begin
|
||||||
|
B:=FTest33.AsBoolean;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.TestVariable33;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : TFPExprIdentifierDef;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVarWrong);
|
||||||
|
FTest33:=I;
|
||||||
|
AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
|
||||||
|
AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure DoGetBooleanVar2Wrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
|
||||||
|
|
||||||
|
begin
|
||||||
|
FVarCallBackName:=AName;
|
||||||
|
Res.ResultType:=rtInteger;
|
||||||
|
Res.ResInteger:=34;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestParserVariables.TestVariable34;
|
||||||
|
|
||||||
|
Var
|
||||||
|
I : TFPExprIdentifierDef;
|
||||||
|
|
||||||
|
begin
|
||||||
|
I:=FP.Identifiers.AddVariable('a',rtBoolean,@DoGetBooleanVar2Wrong);
|
||||||
|
FTest33:=I;
|
||||||
|
AssertException('Changing type results in exception',EExprParser,@DoTestVariable33);
|
||||||
|
AssertEquals('Type is unchanged',Ord(rtBoolean),Ord(i.ResultType));
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
|
Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
|
||||||
@ -4937,6 +5592,7 @@ procedure TTestBuiltins.Setup;
|
|||||||
begin
|
begin
|
||||||
inherited Setup;
|
inherited Setup;
|
||||||
FM:=TExprBuiltInManager.Create(Nil);
|
FM:=TExprBuiltInManager.Create(Nil);
|
||||||
|
FValue:=0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestBuiltins.Teardown;
|
procedure TTestBuiltins.Teardown;
|
||||||
@ -4945,7 +5601,7 @@ begin
|
|||||||
inherited Teardown;
|
inherited Teardown;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestBuiltins.SetExpression(Const AExpression : String);
|
procedure TTestBuiltins.SetExpression(const AExpression: String);
|
||||||
|
|
||||||
Var
|
Var
|
||||||
Msg : String;
|
Msg : String;
|
||||||
@ -5030,11 +5686,41 @@ begin
|
|||||||
AssertDatetimeResult(AResult);
|
AssertDatetimeResult(AResult);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
|
||||||
|
AResult: Int64; AUpdateCount: integer);
|
||||||
|
begin
|
||||||
|
FP.BuiltIns:=AllBuiltIns;
|
||||||
|
SetExpression(AExpression);
|
||||||
|
AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
|
||||||
|
FP.InitAggregate;
|
||||||
|
While AUpdateCount>0 do
|
||||||
|
begin
|
||||||
|
FP.UpdateAggregate;
|
||||||
|
Dec(AUpdateCount);
|
||||||
|
end;
|
||||||
|
AssertResult(AResult);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
|
||||||
|
AResult: TExprFloat; AUpdateCount: integer);
|
||||||
|
begin
|
||||||
|
FP.BuiltIns:=AllBuiltIns;
|
||||||
|
SetExpression(AExpression);
|
||||||
|
AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
|
||||||
|
FP.InitAggregate;
|
||||||
|
While AUpdateCount>0 do
|
||||||
|
begin
|
||||||
|
FP.UpdateAggregate;
|
||||||
|
Dec(AUpdateCount);
|
||||||
|
end;
|
||||||
|
AssertResult(AResult);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TTestBuiltins.TestRegister;
|
procedure TTestBuiltins.TestRegister;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
RegisterStdBuiltins(FM);
|
RegisterStdBuiltins(FM);
|
||||||
AssertEquals('Correct number of identifiers',64,FM.IdentifierCount);
|
AssertEquals('Correct number of identifiers',69,FM.IdentifierCount);
|
||||||
Assertvariable('pi',rtFloat);
|
Assertvariable('pi',rtFloat);
|
||||||
AssertFunction('cos','F','F',bcMath);
|
AssertFunction('cos','F','F',bcMath);
|
||||||
AssertFunction('sin','F','F',bcMath);
|
AssertFunction('sin','F','F',bcMath);
|
||||||
@ -5099,6 +5785,11 @@ begin
|
|||||||
AssertFunction('strtotimedef','D','SD',bcConversion);
|
AssertFunction('strtotimedef','D','SD',bcConversion);
|
||||||
AssertFunction('strtodatetime','D','S',bcConversion);
|
AssertFunction('strtodatetime','D','S',bcConversion);
|
||||||
AssertFunction('strtodatetimedef','D','SD',bcConversion);
|
AssertFunction('strtodatetimedef','D','SD',bcConversion);
|
||||||
|
AssertFunction('sum','F','F',bcAggregate);
|
||||||
|
AssertFunction('count','I','',bcAggregate);
|
||||||
|
AssertFunction('avg','F','F',bcAggregate);
|
||||||
|
AssertFunction('min','F','F',bcAggregate);
|
||||||
|
AssertFunction('max','F','F',bcAggregate);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TTestBuiltins.TestVariablepi;
|
procedure TTestBuiltins.TestVariablepi;
|
||||||
@ -5549,6 +6240,59 @@ begin
|
|||||||
AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
|
AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.TestFunctionAggregateSum;
|
||||||
|
begin
|
||||||
|
FP.Identifiers.AddIntegerVariable('S',2);
|
||||||
|
AssertAggregateExpression('sum(S)',10.0,5);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.TestFunctionAggregateCount;
|
||||||
|
begin
|
||||||
|
AssertAggregateExpression('count',5,5);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure TTestBuiltins.DoAverage(var Result: TFPExpressionResult; ConstRef
|
||||||
|
AName: ShortString);
|
||||||
|
|
||||||
|
begin
|
||||||
|
Inc(FValue);
|
||||||
|
Result.ResInteger:=FValue;
|
||||||
|
Result.ResultType:=rtInteger;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.DoSeries(var Result: TFPExpressionResult; ConstRef
|
||||||
|
AName: ShortString);
|
||||||
|
|
||||||
|
Const
|
||||||
|
Values : Array[1..10] of double =
|
||||||
|
(1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
Inc(FValue);
|
||||||
|
Result.ResFloat:=Values[FValue];
|
||||||
|
Result.ResultType:=rtFloat;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.TestFunctionAggregateAvg;
|
||||||
|
begin
|
||||||
|
FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
|
||||||
|
AssertAggregateExpression('avg(S)',5.5,10);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.TestFunctionAggregateMin;
|
||||||
|
begin
|
||||||
|
FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
|
||||||
|
AssertAggregateExpression('Min(S)',1.1,10);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TTestBuiltins.TestFunctionAggregateMax;
|
||||||
|
begin
|
||||||
|
FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
|
||||||
|
AssertAggregateExpression('Max(S)',9.9,10);
|
||||||
|
end;
|
||||||
|
|
||||||
{ TTestNotNode }
|
{ TTestNotNode }
|
||||||
|
|
||||||
procedure TTestNotNode.TearDown;
|
procedure TTestNotNode.TearDown;
|
||||||
@ -5989,12 +6733,13 @@ initialization
|
|||||||
TTestLessThanNode,TTestLessThanEqualNode,
|
TTestLessThanNode,TTestLessThanEqualNode,
|
||||||
TTestLargerThanNode,TTestLargerThanEqualNode,
|
TTestLargerThanNode,TTestLargerThanEqualNode,
|
||||||
TTestAddNode,TTestSubtractNode,
|
TTestAddNode,TTestSubtractNode,
|
||||||
TTestMultiplyNode,TTestDivideNode,
|
TTestMultiplyNode,TTestDivideNode,TTestPowerNode,
|
||||||
TTestIntToFloatNode,TTestIntToDateTimeNode,
|
TTestIntToFloatNode,TTestIntToDateTimeNode,
|
||||||
TTestFloatToDateTimeNode,
|
TTestFloatToDateTimeNode,
|
||||||
TTestParserExpressions, TTestParserBooleanOperations,
|
TTestParserExpressions, TTestParserBooleanOperations,
|
||||||
TTestParserOperands, TTestParserTypeMatch,
|
TTestParserOperands, TTestParserTypeMatch,
|
||||||
TTestParserVariables,TTestParserFunctions,
|
TTestParserVariables,TTestParserFunctions,
|
||||||
|
TTestParserAggregate,
|
||||||
TTestBuiltinsManager,TTestBuiltins]);
|
TTestBuiltinsManager,TTestBuiltins]);
|
||||||
end.
|
end.
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user