mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-18 20:39:43 +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:
marco
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>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
@ -6,7 +6,6 @@
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasTitleStatement Value="False"/>
|
||||
<UseDefaultCompilerOptions Value="True"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
@ -31,35 +30,35 @@
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
<CommandLineParams Value="--suite=TTestParserVariables.TestVariable31"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<Units Count="2">
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="fclbase-unittests.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="fclbase_unittests"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="tchashlist.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="tchashlist"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="testexprpars.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="project1"/>
|
||||
<Filename Value="fclbase-unittests"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<OtherUnitFiles Value="../src"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
|
||||
@ -10,6 +10,8 @@ var
|
||||
Application: TTestRunner;
|
||||
|
||||
begin
|
||||
DefaultFormat:=fPlain;
|
||||
DefaultRunAllTests:=True;
|
||||
Application := TTestRunner.Create(nil);
|
||||
Application.Initialize;
|
||||
Application.Title := 'FCL-Base unittests';
|
||||
|
||||
@ -20,7 +20,7 @@ unit testexprpars;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars;
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, math, fpexprpars;
|
||||
|
||||
type
|
||||
|
||||
@ -31,6 +31,7 @@ type
|
||||
FP : TFPExpressionScanner;
|
||||
FInvalidString : String;
|
||||
procedure DoInvalidNumber(AString: String);
|
||||
procedure TestIdentifier(const ASource, ATokenName: string);
|
||||
procedure TestInvalidNumber;
|
||||
protected
|
||||
procedure SetUp; override;
|
||||
@ -46,6 +47,7 @@ type
|
||||
Procedure TestInvalidCharacter;
|
||||
Procedure TestUnterminatedString;
|
||||
Procedure TestQuotesInString;
|
||||
Procedure TestIdentifiers;
|
||||
end;
|
||||
|
||||
{ TMyFPExpressionParser }
|
||||
@ -412,6 +414,27 @@ type
|
||||
Procedure TestAsString;
|
||||
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 = Class(TTestBaseParser)
|
||||
@ -701,6 +724,12 @@ type
|
||||
TTestParserVariables = Class(TTestExpressionParser)
|
||||
private
|
||||
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);
|
||||
Protected
|
||||
procedure AddVariabletwice;
|
||||
@ -741,6 +770,10 @@ type
|
||||
procedure TestVariable28;
|
||||
procedure TestVariable29;
|
||||
procedure TestVariable30;
|
||||
procedure TestVariable31;
|
||||
procedure TestVariable32;
|
||||
procedure TestVariable33;
|
||||
procedure TestVariable34;
|
||||
end;
|
||||
|
||||
{ TTestParserFunctions }
|
||||
@ -782,6 +815,45 @@ type
|
||||
procedure TestFunction29;
|
||||
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 = Class(TTestExpressionParser)
|
||||
@ -804,8 +876,11 @@ type
|
||||
|
||||
TTestBuiltins = Class(TTestExpressionParser)
|
||||
private
|
||||
FValue : Integer;
|
||||
FM : TExprBuiltInManager;
|
||||
FExpr : String;
|
||||
procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
|
||||
procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
|
||||
Protected
|
||||
procedure Setup; override;
|
||||
procedure Teardown; override;
|
||||
@ -817,6 +892,8 @@ type
|
||||
procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
|
||||
procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
|
||||
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
|
||||
procedure TestRegister;
|
||||
Procedure TestVariablepi;
|
||||
@ -883,12 +960,337 @@ type
|
||||
Procedure TestFunctionstrtotimedef;
|
||||
Procedure TestFunctionstrtodatetime;
|
||||
Procedure TestFunctionstrtodatetimedef;
|
||||
Procedure TestFunctionAggregateSum;
|
||||
Procedure TestFunctionAggregateCount;
|
||||
Procedure TestFunctionAggregateAvg;
|
||||
Procedure TestFunctionAggregateMin;
|
||||
Procedure TestFunctionAggregateMax;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
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;
|
||||
begin
|
||||
AssertEquals('Empty source','',FP.Source);
|
||||
@ -921,7 +1323,7 @@ Const
|
||||
= ('+','-','<','>','=','/',
|
||||
'*','(',')','<=','>=',
|
||||
'<>','1','''abc''','abc',',','and',
|
||||
'or','xor','true','false','not','if','case','');
|
||||
'or','xor','true','false','not','if','case','^','');
|
||||
|
||||
var
|
||||
t : TTokenType;
|
||||
@ -941,28 +1343,27 @@ procedure TTestExpressionScanner.DoInvalidNumber(AString : String);
|
||||
|
||||
begin
|
||||
FInvalidString:=AString;
|
||||
AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber);
|
||||
AssertException('Invalid number "'+AString+'" ',EExprScanner,@TestInvalidNumber);
|
||||
end;
|
||||
|
||||
procedure TTestExpressionScanner.TestNumber;
|
||||
begin
|
||||
TestString('123',ttNumber);
|
||||
{TestString('123',ttNumber);
|
||||
TestString('123.4',ttNumber);
|
||||
TestString('123.E4',ttNumber);
|
||||
TestString('1.E4',ttNumber);
|
||||
TestString('1e-2',ttNumber);
|
||||
DoInvalidNumber('1..1');
|
||||
}
|
||||
DoInvalidNumber('1.E--1');
|
||||
DoInvalidNumber('.E-1');
|
||||
// DoInvalidNumber('.E-1');
|
||||
end;
|
||||
|
||||
procedure TTestExpressionScanner.TestInvalidCharacter;
|
||||
begin
|
||||
DoInvalidNumber('~');
|
||||
DoInvalidNumber('^');
|
||||
DoInvalidNumber('#');
|
||||
DoInvalidNumber('$');
|
||||
DoInvalidNumber('^');
|
||||
end;
|
||||
|
||||
procedure TTestExpressionScanner.TestUnterminatedString;
|
||||
@ -977,6 +1378,27 @@ begin
|
||||
TestString('''s it''''''',ttString);
|
||||
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;
|
||||
begin
|
||||
FP:=TFPExpressionScanner.Create;
|
||||
@ -1118,15 +1540,16 @@ end;
|
||||
procedure TTestConstExprNode.TestCreateFloat;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
F : Double;
|
||||
C : Integer;
|
||||
|
||||
begin
|
||||
FN:=TFPConstExpression.CreateFloat(2.34);
|
||||
AssertEquals('Correct type',rtFloat,FN.NodeType);
|
||||
AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
|
||||
AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
|
||||
Str(TExprFLoat(2.34),S);
|
||||
AssertEquals('AsString ok',S,FN.AsString);
|
||||
Val(FN.AsString,F,C);
|
||||
AssertEquals('AsString ok',2.34,F,0.001);
|
||||
end;
|
||||
|
||||
procedure TTestConstExprNode.TestCreateBoolean;
|
||||
@ -2026,6 +2449,130 @@ begin
|
||||
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 }
|
||||
|
||||
procedure TTestDivideNode.TearDown;
|
||||
@ -4196,6 +4743,114 @@ begin
|
||||
AssertEquals('Correct value',False,I.AsBoolean);
|
||||
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);
|
||||
@ -4937,6 +5592,7 @@ procedure TTestBuiltins.Setup;
|
||||
begin
|
||||
inherited Setup;
|
||||
FM:=TExprBuiltInManager.Create(Nil);
|
||||
FValue:=0;
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.Teardown;
|
||||
@ -4945,7 +5601,7 @@ begin
|
||||
inherited Teardown;
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.SetExpression(Const AExpression : String);
|
||||
procedure TTestBuiltins.SetExpression(const AExpression: String);
|
||||
|
||||
Var
|
||||
Msg : String;
|
||||
@ -5030,11 +5686,41 @@ begin
|
||||
AssertDatetimeResult(AResult);
|
||||
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;
|
||||
|
||||
begin
|
||||
RegisterStdBuiltins(FM);
|
||||
AssertEquals('Correct number of identifiers',64,FM.IdentifierCount);
|
||||
AssertEquals('Correct number of identifiers',69,FM.IdentifierCount);
|
||||
Assertvariable('pi',rtFloat);
|
||||
AssertFunction('cos','F','F',bcMath);
|
||||
AssertFunction('sin','F','F',bcMath);
|
||||
@ -5099,6 +5785,11 @@ begin
|
||||
AssertFunction('strtotimedef','D','SD',bcConversion);
|
||||
AssertFunction('strtodatetime','D','S',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;
|
||||
|
||||
procedure TTestBuiltins.TestVariablepi;
|
||||
@ -5549,6 +6240,59 @@ begin
|
||||
AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
|
||||
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 }
|
||||
|
||||
procedure TTestNotNode.TearDown;
|
||||
@ -5989,12 +6733,13 @@ initialization
|
||||
TTestLessThanNode,TTestLessThanEqualNode,
|
||||
TTestLargerThanNode,TTestLargerThanEqualNode,
|
||||
TTestAddNode,TTestSubtractNode,
|
||||
TTestMultiplyNode,TTestDivideNode,
|
||||
TTestMultiplyNode,TTestDivideNode,TTestPowerNode,
|
||||
TTestIntToFloatNode,TTestIntToDateTimeNode,
|
||||
TTestFloatToDateTimeNode,
|
||||
TTestParserExpressions, TTestParserBooleanOperations,
|
||||
TTestParserOperands, TTestParserTypeMatch,
|
||||
TTestParserVariables,TTestParserFunctions,
|
||||
TTestParserAggregate,
|
||||
TTestBuiltinsManager,TTestBuiltins]);
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user