{ This file is part of the Free Component Library (FCL) Copyright (c) 2008 Michael Van Canneyt. File which provides examples and all testcases for the expression parser. It needs fcl-fpcunit to work. See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit testexprpars; {$mode objfpc}{$H+} interface uses Classes, SysUtils, fpcunit, testutils, testregistry,fpexprpars; type { TTestExpressionScanner } TTestExpressionScanner = class(TTestCase) Private FP : TFPExpressionScanner; FInvalidString : String; procedure DoInvalidNumber(AString: String); procedure TestInvalidNumber; protected procedure SetUp; override; procedure TearDown; override; Procedure AssertEquals(Msg : string; AExpected, AActual : TTokenType); overload; Procedure TestString(Const AString : String; AToken : TTokenType); published procedure TestCreate; procedure TestSetSource; Procedure TestWhiteSpace; Procedure TestTokens; Procedure TestNumber; Procedure TestInvalidCharacter; Procedure TestUnterminatedString; Procedure TestQuotesInString; end; { TMyFPExpressionParser } TMyFPExpressionParser = Class(TFPExpressionParser) Public Procedure BuildHashList; Property ExprNode; Property Scanner; Property Dirty; end; { TTestBaseParser } TTestBaseParser = class(TTestCase) private procedure DoCheck; Protected FDestroyCalled : Integer; FCheckNode : TFPExprNode; procedure AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); overload; procedure AssertEquals(Msg: String; AResultType : TResultType; ANode: TFPExprNode); overload; procedure AssertEquals(Msg: String; AExpected,AActual : TResultType); overload; Function CreateBoolNode(ABoolean: Boolean) : TFPExprNode; Function CreateIntNode(AInteger: Integer) : TFPExprNode; Function CreateFloatNode(AFloat : TExprFloat) : TFPExprNode; Function CreateStringNode(Astring : String) : TFPExprNode; Function CreateDateTimeNode(ADateTime : TDateTime) : TFPExprNode; Procedure AssertNodeOK(FN : TFPExprNode); Procedure AssertNodeNotOK(Const Msg : String; FN : TFPExprNode); Procedure Setup; override; end; { TMyDestroyNode } TMyDestroyNode = Class(TFPConstExpression) FTest : TTestBaseParser; Public Constructor CreateTest(ATest : TTestBaseParser); Destructor Destroy; override; end; { TTestDestroyNode } TTestDestroyNode = Class(TTestBaseParser) Published Procedure TestDestroy; end; { TTestConstExprNode } TTestConstExprNode = Class(TTestBaseParser) private FN : TFPConstExpression; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateFloat; procedure TestCreateBoolean; procedure TestCreateDateTime; procedure TestCreateString; end; { TTestNegateExprNode } TTestNegateExprNode = Class(TTestBaseParser) Private FN : TFPNegateOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateFloat; procedure TestCreateOther1; procedure TestCreateOther2; Procedure TestDestroy; end; { TTestBinaryAndNode } TTestBinaryAndNode = Class(TTestBaseParser) Private FN : TFPBinaryAndOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateBoolean; procedure TestCreateBooleanInteger; procedure TestCreateString; procedure TestCreateFloat; procedure TestCreateDateTime; Procedure TestDestroy; end; { TTestNotNode } TTestNotNode = Class(TTestBaseParser) Private FN : TFPNotNode; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateBoolean; procedure TestCreateString; procedure TestCreateFloat; procedure TestCreateDateTime; Procedure TestDestroy; end; { TTestBinaryOrNode } TTestBinaryOrNode = Class(TTestBaseParser) Private FN : TFPBinaryOrOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateBoolean; procedure TestCreateBooleanInteger; procedure TestCreateString; procedure TestCreateFloat; procedure TestCreateDateTime; Procedure TestDestroy; end; { TTestBinaryXOrNode } TTestBinaryXOrNode = Class(TTestBaseParser) Private FN : TFPBinaryXOrOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateBoolean; procedure TestCreateBooleanInteger; procedure TestCreateString; procedure TestCreateFloat; procedure TestCreateDateTime; Procedure TestDestroy; end; { TTestIfOperation } TTestIfOperation = Class(TTestBaseParser) Private FN : TIfOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; procedure TestCreateBoolean; procedure TestCreateBoolean2; procedure TestCreateString; procedure TestCreateFloat; procedure TestCreateDateTime; procedure TestCreateBooleanInteger; procedure TestCreateBooleanInteger2; procedure TestCreateBooleanString; procedure TestCreateBooleanString2; procedure TestCreateBooleanDateTime; procedure TestCreateBooleanDateTime2; Procedure TestDestroy; end; { TTestCaseOperation } TTestCaseOperation = Class(TTestBaseParser) Private FN : TCaseOperation; Protected Function CreateArgs(Args : Array of Const) : TExprArgumentArray; Procedure TearDown; override; Published Procedure TestCreateOne; procedure TestCreateTwo; procedure TestCreateThree; procedure TestCreateOdd; procedure TestCreateNoExpression; procedure TestCreateWrongLabel; procedure TestCreateWrongValue; procedure TestIntegerTag; procedure TestIntegerTagDefault; procedure TestStringTag; procedure TestStringTagDefault; procedure TestFloatTag; procedure TestFloatTagDefault; procedure TestBooleanTag; procedure TestBooleanTagDefault; procedure TestDateTimeTag; procedure TestDateTimeTagDefault; procedure TestIntegerValue; procedure TestIntegerValueDefault; procedure TestStringValue; procedure TestStringValueDefault; procedure TestFloatValue; procedure TestFloatValueDefault; procedure TestBooleanValue; procedure TestBooleanValueDefault; procedure TestDateTimeValue; procedure TestDateTimeValueDefault; Procedure TestDestroy; end; { TTestBooleanNode } TTestBooleanNode = Class(TTestBaseParser) Protected Procedure TestNode(B : TFPBooleanResultOperation; AResult : Boolean); end; { TTestEqualNode } TTestEqualNode = Class(TTestBooleanNode) Private FN : TFPBooleanResultOperation; Protected Procedure TearDown; override; Class Function NodeClass : TFPBooleanResultOperationClass; virtual; Class Function ExpectedResult : Boolean; virtual; Class Function OperatorString : String; virtual; Published Procedure TestCreateIntegerEqual; procedure TestCreateIntegerUnEqual; Procedure TestCreateFloatEqual; procedure TestCreateFloatUnEqual; Procedure TestCreateStringEqual; procedure TestCreateStringUnEqual; Procedure TestCreateBooleanEqual; procedure TestCreateBooleanUnEqual; Procedure TestCreateDateTimeEqual; procedure TestCreateDateTimeUnEqual; Procedure TestDestroy; Procedure TestWrongTypes1; procedure TestWrongTypes2; procedure TestWrongTypes3; procedure TestWrongTypes4; procedure TestWrongTypes5; Procedure TestAsString; end; { TTestUnEqualNode } TTestUnEqualNode = Class(TTestEqualNode) Protected Class Function NodeClass : TFPBooleanResultOperationClass; override; Class Function ExpectedResult : Boolean; override; Class Function OperatorString : String; override; end; { TTestLessThanNode } TTestLessThanNode = Class(TTestBooleanNode) Private FN : TFPBooleanResultOperation; Protected Class Function NodeClass : TFPBooleanResultOperationClass; virtual; Class Function Larger : Boolean; virtual; Class Function AllowEqual : Boolean; virtual; Class Function OperatorString : String; virtual; Procedure TearDown; override; Published Procedure TestCreateIntegerEqual; procedure TestCreateIntegerSmaller; procedure TestCreateIntegerLarger; Procedure TestCreateFloatEqual; procedure TestCreateFloatSmaller; procedure TestCreateFloatLarger; Procedure TestCreateDateTimeEqual; procedure TestCreateDateTimeSmaller; procedure TestCreateDateTimeLarger; Procedure TestCreateStringEqual; procedure TestCreateStringSmaller; procedure TestCreateStringLarger; Procedure TestWrongTypes1; procedure TestWrongTypes2; procedure TestWrongTypes3; procedure TestWrongTypes4; procedure TestWrongTypes5; Procedure TestNoBoolean1; Procedure TestNoBoolean2; Procedure TestNoBoolean3; Procedure TestAsString; end; { TTestLessThanEqualNode } TTestLessThanEqualNode = Class(TTestLessThanNode) protected Class Function NodeClass : TFPBooleanResultOperationClass; override; Class Function AllowEqual : Boolean; override; Class Function OperatorString : String; override; end; { TTestLargerThanNode } TTestLargerThanNode = Class(TTestLessThanNode) protected Class Function NodeClass : TFPBooleanResultOperationClass; override; Class Function Larger : Boolean; override; Class Function OperatorString : String; override; end; { TTestLargerThanEqualNode } TTestLargerThanEqualNode = Class(TTestLargerThanNode) protected Class Function NodeClass : TFPBooleanResultOperationClass; override; Class Function AllowEqual : Boolean; override; Class Function OperatorString : String; override; end; { TTestAddNode } TTestAddNode = Class(TTestBaseParser) Private FN : TFPAddOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestCreateDateTime; Procedure TestCreateString; Procedure TestCreateBoolean; Procedure TestDestroy; Procedure TestAsString; end; { TTestSubtractNode } TTestSubtractNode = Class(TTestBaseParser) Private FN : TFPSubtractOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestCreateDateTime; Procedure TestCreateString; Procedure TestCreateBoolean; Procedure TestDestroy; Procedure TestAsString; end; { TTestMultiplyNode } TTestMultiplyNode = Class(TTestBaseParser) Private FN : TFPMultiplyOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestCreateDateTime; Procedure TestCreateString; Procedure TestCreateBoolean; Procedure TestDestroy; Procedure TestAsString; end; { TTestDivideNode } TTestDivideNode = Class(TTestBaseParser) Private FN : TFPDivideOperation; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestCreateDateTime; Procedure TestCreateString; Procedure TestCreateBoolean; Procedure TestDestroy; Procedure TestAsString; end; { TTestIntToFloatNode } TTestIntToFloatNode = Class(TTestBaseParser) Private FN : TIntToFloatNode; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestDestroy; Procedure TestAsString; end; { TTestIntToDateTimeNode } TTestIntToDateTimeNode = Class(TTestBaseParser) Private FN : TIntToDateTimeNode; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestDestroy; Procedure TestAsString; end; { TTestFloatToDateTimeNode } TTestFloatToDateTimeNode = Class(TTestBaseParser) Private FN : TFloatToDateTimeNode; Protected Procedure TearDown; override; Published Procedure TestCreateInteger; Procedure TestCreateFloat; Procedure TestDestroy; Procedure TestAsString; end; { TTestExpressionParser } TTestExpressionParser = class(TTestBaseParser) Private FP : TMyFPExpressionParser; FTestExpr : String; procedure DoAddInteger(var Result: TFPExpressionResult; const Args: TExprParameterArray); procedure DoDeleteString(var Result: TFPExpressionResult; const Args: TExprParameterArray); procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray); procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray); procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray); procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray); procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray); procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray); procedure DoParse; procedure TestParser(AExpr: string); protected procedure SetUp; override; procedure TearDown; override; Procedure AssertLeftRight(N : TFPExprNode; LeftClass,RightClass : TClass); Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass); Procedure AssertResultType(RT : TResultType); Procedure AssertResult(F : TExprFloat); Procedure AssertResult(I : Int64); Procedure AssertResult(S : String); Procedure AssertResult(B : Boolean); Procedure AssertDateTimeResult(D : TDateTime); end; { TTestParserExpressions } TTestParserExpressions = Class(TTestExpressionParser) private Published Procedure TestCreate; Procedure TestSimpleNodeFloat; procedure TestSimpleNodeInteger; procedure TestSimpleNodeBooleanTrue; procedure TestSimpleNodeBooleanFalse; procedure TestSimpleNodeString; procedure TestSimpleNegativeInteger; procedure TestSimpleNegativeFloat; procedure TestSimpleAddInteger; procedure TestSimpleAddFloat; procedure TestSimpleAddIntegerFloat; procedure TestSimpleAddFloatInteger; procedure TestSimpleAddString; procedure TestSimpleSubtractInteger; procedure TestSimpleSubtractFloat; procedure TestSimpleSubtractIntegerFloat; procedure TestSimpleSubtractFloatInteger; procedure TestSimpleMultiplyFloat; procedure TestSimpleMultiplyInteger; procedure TestSimpleDivideFloat; procedure TestSimpleDivideInteger; procedure TestSimpleBooleanAnd; procedure TestSimpleIntegerAnd; procedure TestSimpleBooleanOr; procedure TestSimpleIntegerOr; procedure TestSimpleBooleanNot; procedure TestSimpleIntegerNot; procedure TestSimpleAddSeries; procedure TestSimpleMultiplySeries; procedure TestSimpleAddMultiplySeries; procedure TestSimpleAddAndSeries; procedure TestSimpleAddOrSeries; procedure TestSimpleOrNotSeries; procedure TestSimpleAndNotSeries; procedure TestDoubleAddMultiplySeries; procedure TestDoubleSubtractMultiplySeries; procedure TestSimpleIfInteger; procedure TestSimpleIfString; procedure TestSimpleIfFloat; procedure TestSimpleIfBoolean; procedure TestSimpleIfDateTime; procedure TestSimpleIfOperation; procedure TestSimpleBrackets; procedure TestSimpleBrackets2; procedure TestSimpleBracketsLeft; procedure TestSimpleBracketsRight; procedure TestSimpleBracketsDouble; end; TTestParserBooleanOperations = Class(TTestExpressionParser) Published Procedure TestEqualInteger; procedure TestUnEqualInteger; procedure TestEqualFloat; procedure TestEqualFloat2; procedure TestUnEqualFloat; procedure TestEqualString; procedure TestEqualString2; procedure TestUnEqualString; procedure TestUnEqualString2; Procedure TestEqualBoolean; procedure TestUnEqualBoolean; procedure TestLessThanInteger; procedure TestLessThanInteger2; procedure TestLessThanEqualInteger; procedure TestLessThanEqualInteger2; procedure TestLessThanFloat; procedure TestLessThanFloat2; procedure TestLessThanEqualFloat; procedure TestLessThanEqualFloat2; procedure TestLessThanString; procedure TestLessThanString2; procedure TestLessThanEqualString; procedure TestLessThanEqualString2; procedure TestGreaterThanInteger; procedure TestGreaterThanInteger2; procedure TestGreaterThanEqualInteger; procedure TestGreaterThanEqualInteger2; procedure TestGreaterThanFloat; procedure TestGreaterThanFloat2; procedure TestGreaterThanEqualFloat; procedure TestGreaterThanEqualFloat2; procedure TestGreaterThanString; procedure TestGreaterThanString2; procedure TestGreaterThanEqualString; procedure TestGreaterThanEqualString2; procedure EqualAndSeries; procedure EqualAndSeries2; procedure EqualOrSeries; procedure EqualOrSeries2; procedure UnEqualAndSeries; procedure UnEqualAndSeries2; procedure UnEqualOrSeries; procedure UnEqualOrSeries2; procedure LessThanAndSeries; procedure LessThanAndSeries2; procedure LessThanOrSeries; procedure LessThanOrSeries2; procedure GreaterThanAndSeries; procedure GreaterThanAndSeries2; procedure GreaterThanOrSeries; procedure GreaterThanOrSeries2; procedure LessThanEqualAndSeries; procedure LessThanEqualAndSeries2; procedure LessThanEqualOrSeries; procedure LessThanEqualOrSeries2; procedure GreaterThanEqualAndSeries; procedure GreaterThanEqualAndSeries2; procedure GreaterThanEqualOrSeries; procedure GreaterThanEqualOrSeries2; end; { TTestParserOperands } TTestParserOperands = Class(TTestExpressionParser) private Published Procedure MissingOperand1; procedure MissingOperand2; procedure MissingOperand3; procedure MissingOperand4; procedure MissingOperand5; procedure MissingOperand6; procedure MissingOperand7; procedure MissingOperand8; procedure MissingOperand9; procedure MissingOperand10; procedure MissingOperand11; procedure MissingOperand12; procedure MissingOperand13; procedure MissingOperand14; procedure MissingOperand15; procedure MissingOperand16; procedure MissingOperand17; procedure MissingOperand18; procedure MissingOperand19; procedure MissingOperand20; procedure MissingOperand21; procedure MissingBracket1; procedure MissingBracket2; procedure MissingBracket3; procedure MissingBracket4; procedure MissingBracket5; procedure MissingBracket6; procedure MissingBracket7; procedure MissingArgument1; procedure MissingArgument2; procedure MissingArgument3; procedure MissingArgument4; procedure MissingArgument5; procedure MissingArgument6; procedure MissingArgument7; end; { TTestParserTypeMatch } TTestParserTypeMatch = Class(TTestExpressionParser) Private Procedure AccessString; Procedure AccessInteger; Procedure AccessFloat; Procedure AccessDateTime; Procedure AccessBoolean; Published Procedure TestTypeMismatch1; procedure TestTypeMismatch2; procedure TestTypeMismatch3; procedure TestTypeMismatch4; procedure TestTypeMismatch5; procedure TestTypeMismatch6; procedure TestTypeMismatch7; procedure TestTypeMismatch8; procedure TestTypeMismatch9; procedure TestTypeMismatch10; procedure TestTypeMismatch11; procedure TestTypeMismatch12; procedure TestTypeMismatch13; procedure TestTypeMismatch14; procedure TestTypeMismatch15; procedure TestTypeMismatch16; procedure TestTypeMismatch17; procedure TestTypeMismatch18; procedure TestTypeMismatch19; procedure TestTypeMismatch20; procedure TestTypeMismatch21; procedure TestTypeMismatch22; procedure TestTypeMismatch23; procedure TestTypeMismatch24; end; { TTestParserVariables } TTestParserVariables = Class(TTestExpressionParser) private FAsWrongType : TResultType; procedure TestAccess(Skip: TResultType); Protected procedure AddVariabletwice; procedure UnknownVariable; Procedure ReadWrongType; procedure WriteWrongType; Procedure DoDummy(var Result: TFPExpressionResult; Const Args: TExprParameterArray); Published Procedure TestVariableAssign; Procedure TestVariableAssignAgain; Procedure TestVariable1; procedure TestVariable2; procedure TestVariable3; procedure TestVariable4; procedure TestVariable5; procedure TestVariable6; procedure TestVariable7; procedure TestVariable8; procedure TestVariable9; procedure TestVariable10; procedure TestVariable11; procedure TestVariable12; procedure TestVariable13; procedure TestVariable14; procedure TestVariable15; procedure TestVariable16; procedure TestVariable17; procedure TestVariable18; procedure TestVariable19; procedure TestVariable20; procedure TestVariable21; procedure TestVariable22; procedure TestVariable23; procedure TestVariable24; procedure TestVariable25; procedure TestVariable26; procedure TestVariable27; procedure TestVariable28; procedure TestVariable29; procedure TestVariable30; end; { TTestParserFunctions } TTestParserFunctions = Class(TTestExpressionParser) private FAccessAs : TResultType; Procedure TryRead; procedure TryWrite; Published Procedure TestFunction1; procedure TestFunction2; procedure TestFunction3; procedure TestFunction4; procedure TestFunction5; procedure TestFunction6; procedure TestFunction7; procedure TestFunction8; procedure TestFunction9; procedure TestFunction10; procedure TestFunction11; procedure TestFunction12; procedure TestFunction13; procedure TestFunction14; procedure TestFunction15; procedure TestFunction16; procedure TestFunction17; procedure TestFunction18; procedure TestFunction19; procedure TestFunction20; procedure TestFunction21; procedure TestFunction22; procedure TestFunction23; procedure TestFunction24; procedure TestFunction25; procedure TestFunction26; procedure TestFunction27; procedure TestFunction28; procedure TestFunction29; end; { TTestBuiltinsManager } TTestBuiltinsManager = Class(TTestExpressionParser) private FM : TExprBuiltInManager; Protected procedure Setup; override; procedure Teardown; override; Published procedure TestCreate; procedure TestVariable1; procedure TestVariable2; procedure TestVariable3; procedure TestVariable4; procedure TestVariable5; procedure TestVariable6; procedure TestFunction1; procedure TestFunction2; end; TTestBuiltins = Class(TTestExpressionParser) private FM : TExprBuiltInManager; FExpr : String; Protected procedure Setup; override; procedure Teardown; override; Procedure SetExpression(Const AExpression : String); Procedure AssertVariable(Const ADefinition : String; AResultType : TResultType); Procedure AssertFunction(Const ADefinition,AResultType,ArgumentTypes : String; ACategory : TBuiltinCategory); procedure AssertExpression(Const AExpression : String; AResult : Int64); procedure AssertExpression(Const AExpression : String; Const AResult : String); procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat); procedure AssertExpression(Const AExpression : String; Const AResult : Boolean); procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime); Published procedure TestRegister; Procedure TestVariablepi; Procedure TestFunctioncos; Procedure TestFunctionsin; Procedure TestFunctionarctan; Procedure TestFunctionabs; Procedure TestFunctionsqr; Procedure TestFunctionsqrt; Procedure TestFunctionexp; Procedure TestFunctionln; Procedure TestFunctionlog; Procedure TestFunctionfrac; Procedure TestFunctionint; Procedure TestFunctionround; Procedure TestFunctiontrunc; Procedure TestFunctionlength; Procedure TestFunctioncopy; Procedure TestFunctiondelete; Procedure TestFunctionpos; Procedure TestFunctionlowercase; Procedure TestFunctionuppercase; Procedure TestFunctionstringreplace; Procedure TestFunctioncomparetext; Procedure TestFunctiondate; Procedure TestFunctiontime; Procedure TestFunctionnow; Procedure TestFunctiondayofweek; Procedure TestFunctionextractyear; Procedure TestFunctionextractmonth; Procedure TestFunctionextractday; Procedure TestFunctionextracthour; Procedure TestFunctionextractmin; Procedure TestFunctionextractsec; Procedure TestFunctionextractmsec; Procedure TestFunctionencodedate; Procedure TestFunctionencodetime; Procedure TestFunctionencodedatetime; Procedure TestFunctionshortdayname; Procedure TestFunctionshortmonthname; Procedure TestFunctionlongdayname; Procedure TestFunctionlongmonthname; Procedure TestFunctionformatdatetime; Procedure TestFunctionshl; Procedure TestFunctionshr; Procedure TestFunctionIFS; Procedure TestFunctionIFF; Procedure TestFunctionIFD; Procedure TestFunctionIFI; Procedure TestFunctioninttostr; Procedure TestFunctionstrtoint; Procedure TestFunctionstrtointdef; Procedure TestFunctionfloattostr; Procedure TestFunctionstrtofloat; Procedure TestFunctionstrtofloatdef; Procedure TestFunctionbooltostr; Procedure TestFunctionstrtobool; Procedure TestFunctionstrtobooldef; Procedure TestFunctiondatetostr; Procedure TestFunctiontimetostr; Procedure TestFunctionstrtodate; Procedure TestFunctionstrtodatedef; Procedure TestFunctionstrtotime; Procedure TestFunctionstrtotimedef; Procedure TestFunctionstrtodatetime; Procedure TestFunctionstrtodatetimedef; end; implementation uses typinfo; procedure TTestExpressionScanner.TestCreate; begin AssertEquals('Empty source','',FP.Source); AssertEquals('Pos is zero',0,FP.Pos); AssertEquals('CurrentChar is zero',#0,FP.CurrentChar); AssertEquals('Current token type is EOF',ttEOF,FP.TokenType); AssertEquals('Current token is empty','',FP.Token); end; procedure TTestExpressionScanner.TestSetSource; begin FP.Source:='Abc'; FP.Source:=''; AssertEquals('Empty source','',FP.Source); AssertEquals('Pos is zero',0,FP.Pos); AssertEquals('CurrentChar is zero',#0,FP.CurrentChar); AssertEquals('Current token type is EOF',ttEOF,FP.TokenType); AssertEquals('Current token is empty','',FP.Token); end; procedure TTestExpressionScanner.TestWhiteSpace; begin TestString(' ',ttEOF); end; procedure TTestExpressionScanner.TestTokens; Const TestStrings : Array[TTokenType] of String = ('+','-','<','>','=','/', '*','(',')','<=','>=', '<>','1','''abc''','abc',',','and', 'or','xor','true','false','not','if','case',''); var t : TTokenType; begin For T:=Low(TTokenType) to High(TTokenType) do TestString(TestStrings[t],t); end; procedure TTestExpressionScanner.TestInvalidNumber; begin TestString(FInvalidString,ttNumber); end; procedure TTestExpressionScanner.DoInvalidNumber(AString : String); begin FInvalidString:=AString; AssertException('Invalid number "'+AString+'"',EExprScanner,@TestInvalidNumber); end; procedure TTestExpressionScanner.TestNumber; begin 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'); end; procedure TTestExpressionScanner.TestInvalidCharacter; begin DoInvalidNumber('~'); DoInvalidNumber('^'); DoInvalidNumber('#'); DoInvalidNumber('$'); DoInvalidNumber('^'); end; procedure TTestExpressionScanner.TestUnterminatedString; begin DoInvalidNumber('''abc'); end; procedure TTestExpressionScanner.TestQuotesInString; begin TestString('''That''''s it''',ttString); TestString('''''''s it''',ttString); TestString('''s it''''''',ttString); end; procedure TTestExpressionScanner.SetUp; begin FP:=TFPExpressionScanner.Create; end; procedure TTestExpressionScanner.TearDown; begin FreeAndNil(FP); end; procedure TTestExpressionScanner.AssertEquals(Msg: string; AExpected, AActual: TTokenType); Var S1,S2 : String; begin S1:=TokenName(AExpected); S2:=GetEnumName(TypeInfo(TTokenType),Ord(AActual)); AssertEquals(Msg,S1,S2); end; procedure TTestExpressionScanner.TestString(const AString: String; AToken: TTokenType); begin FP.Source:=AString; AssertEquals('String "'+AString+'" results in token '+TokenName(AToken),AToken,FP.GetToken); If Not (FP.TokenType in [ttString,ttEOF]) then AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken),AString,FP.Token) else if FP.TokenType=ttString then AssertEquals('String "'+AString+'" results in token string '+TokenName(AToken), StringReplace(AString,'''''','''',[rfreplaceAll]), ''''+FP.Token+''''); end; { TTestBaseParser } procedure TTestBaseParser.DoCheck; begin FCheckNode.Check; end; procedure TTestBaseParser.AssertNodeType(Msg: String; AClass: TClass; ANode: TFPExprNode); begin AssertNotNull(Msg+': Not null',ANode); AssertEquals(Msg+': Class OK',AClass,ANode.ClassType); end; procedure TTestBaseParser.AssertEquals(Msg: String; AResultType: TResultType; ANode: TFPExprNode); begin AssertNotNull(Msg+': Node not null',ANode); AssertEquals(Msg,AResultType,Anode.NodeType); end; procedure TTestBaseParser.AssertEquals(Msg: String; AExpected, AActual: TResultType); begin AssertEquals(Msg,ResultTypeName(AExpected),ResultTypeName(AActual)); end; function TTestBaseParser.CreateIntNode(AInteger: Integer): TFPExprNode; begin Result:=TFPConstExpression.CreateInteger(AInteger); end; function TTestBaseParser.CreateFloatNode(AFloat: TExprFloat): TFPExprNode; begin Result:=TFPConstExpression.CreateFloat(AFloat); end; function TTestBaseParser.CreateStringNode(Astring: String): TFPExprNode; begin Result:=TFPConstExpression.CreateString(AString); end; function TTestBaseParser.CreateDateTimeNode(ADateTime: TDateTime): TFPExprNode; begin Result:=TFPConstExpression.CreateDateTime(ADateTime); end; procedure TTestBaseParser.AssertNodeOK(FN: TFPExprNode); Var B : Boolean; Msg : String; begin AssertNotNull('Node to test OK',FN); B:=False; try FN.Check; B:=True; except On E : Exception do Msg:=E.Message; end; If Not B then Fail(Format('Node %s not OK: %s',[FN.ClassName,Msg])); end; procedure TTestBaseParser.AssertNodeNotOK(const MSg : String; FN: TFPExprNode); begin FCheckNode:=FN; AssertException(Msg,EExprParser,@DoCheck); end; function TTestBaseParser.CreateBoolNode(ABoolean: Boolean): TFPExprNode; begin Result:=TFPConstExpression.CreateBoolean(ABoolean); end; procedure TTestBaseParser.Setup; begin inherited Setup; FDestroyCalled:=0; end; { TTestConstExprNode } procedure TTestConstExprNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestConstExprNode.TestCreateInteger; begin FN:=TFPConstExpression.CreateInteger(1); AssertEquals('Correct type',rtInteger,FN.NodeType); AssertEquals('Correct result',1,FN.ConstValue.ResInteger); AssertEquals('Correct result',1,FN.NodeValue.ResInteger); AssertEquals('AsString ok','1',FN.AsString); end; procedure TTestConstExprNode.TestCreateFloat; Var S : String; 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); end; procedure TTestConstExprNode.TestCreateBoolean; begin FN:=TFPConstExpression.CreateBoolean(True); AssertEquals('Correct type',rtBoolean,FN.NodeType); AssertEquals('Correct result',True,FN.ConstValue.ResBoolean); AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); AssertEquals('AsString ok','True',FN.AsString); FreeAndNil(FN); FN:=TFPConstExpression.CreateBoolean(False); AssertEquals('AsString ok','False',FN.AsString); end; procedure TTestConstExprNode.TestCreateDateTime; Var D : TDateTime; S : String; begin D:=Now; FN:=TFPConstExpression.CreateDateTime(D); AssertEquals('Correct type',rtDateTime,FN.NodeType); AssertEquals('Correct result',D,FN.ConstValue.ResDateTime); AssertEquals('Correct result',D,FN.NodeValue.ResDateTime); S:=''''+FormatDateTime('cccc',D)+''''; AssertEquals('AsString ok',S,FN.AsString); end; procedure TTestConstExprNode.TestCreateString; Var S : String; begin S:='Ohlala'; FN:=TFPConstExpression.CreateString(S); AssertEquals('Correct type',rtString,FN.NodeType); AssertEquals('Correct result',S,FN.ConstValue.ResString); AssertEquals('Correct result',S,FN.NodeValue.ResString); AssertEquals('AsString ok',''''+S+'''',FN.AsString); end; { TTestNegateExprNode } procedure TTestNegateExprNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestNegateExprNode.TestCreateInteger; begin FN:=TFPNegateOperation.Create(CreateIntNode(23)); AssertEquals('Negate has correct type',rtInteger,FN.NodeType); AssertEquals('Negate has correct result',-23,FN.NodeValue.Resinteger); AssertEquals('Negate has correct string','-23',FN.AsString); AssertNodeOK(FN); end; procedure TTestNegateExprNode.TestCreateFloat; Var S : String; begin FN:=TFPNegateOperation.Create(CreateFloatNode(1.23)); AssertEquals('Negate has correct type',rtFloat,FN.NodeType); AssertEquals('Negate has correct result',-1.23,FN.NodeValue.ResFloat); Str(TExprFloat(-1.23),S); AssertEquals('Negate has correct string',S,FN.AsString); AssertNodeOK(FN); end; procedure TTestNegateExprNode.TestCreateOther1; begin FN:=TFPNegateOperation.Create(TFPConstExpression.CreateString('1.23')); AssertNodeNotOK('Negate does not accept string',FN); end; procedure TTestNegateExprNode.TestCreateOther2; begin FN:=TFPNegateOperation.Create(TFPConstExpression.CreateBoolean(True)); AssertNodeNotOK('Negate does not accept boolean',FN) end; procedure TTestNegateExprNode.TestDestroy; begin FN:=TFPNegateOperation.Create(TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Operand Destroy called',1,self.FDestroyCalled) end; { TTestDestroyNode } procedure TTestDestroyNode.TestDestroy; Var FN : TMyDestroyNode; begin AssertEquals('Destroy not called yet',0,self.FDestroyCalled); FN:=TMyDestroyNode.CreateTest(Self); FN.Free; AssertEquals('Destroy called',1,self.FDestroyCalled) end; { TMyDestroyNode } constructor TMyDestroyNode.CreateTest(ATest: TTestBaseParser); begin FTest:=ATest; Inherited CreateInteger(1); end; destructor TMyDestroyNode.Destroy; begin Inc(FTest.FDestroyCalled); inherited Destroy; end; { TTestBinaryAndNode } procedure TTestBinaryAndNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestBinaryAndNode.TestCreateInteger; begin FN:=TFPBinaryAndOperation.Create(CreateIntNode(3),CreateIntNode(2)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',2,FN.NodeValue.ResInteger); end; procedure TTestBinaryAndNode.TestCreateBoolean; begin FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateBoolNode(True)); AssertNodeOK(FN); AssertEquals('Correct node type',rtBoolean,FN.NodeType); AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); end; procedure TTestBinaryAndNode.TestCreateBooleanInteger; begin FN:=TFPBinaryAndOperation.Create(CreateBoolNode(True),CreateIntNode(0)); AssertNodeNotOK('Different node types',FN); end; procedure TTestBinaryAndNode.TestCreateString; begin FN:=TFPBinaryAndOperation.Create(CreateStringNode('True'),CreateStringNode('True')); AssertNodeNotOK('String node type',FN); end; procedure TTestBinaryAndNode.TestCreateFloat; begin FN:=TFPBinaryAndOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); AssertNodeNotOK('float node type',FN); end; procedure TTestBinaryAndNode.TestCreateDateTime; begin FN:=TFPBinaryAndOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now)); AssertNodeNotOK('DateTime node type',FN); end; procedure TTestBinaryAndNode.TestDestroy; begin FN:=TFPBinaryAndOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; { TTestBinaryOrNode } procedure TTestBinaryOrNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestBinaryOrNode.TestCreateInteger; begin FN:=TFPBinaryOrOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',3,FN.NodeValue.ResInteger); end; procedure TTestBinaryOrNode.TestCreateBoolean; begin FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); AssertNodeOK(FN); AssertEquals('Correct node type',rtBoolean,FN.NodeType); AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); end; procedure TTestBinaryOrNode.TestCreateBooleanInteger; begin FN:=TFPBinaryOrOperation.Create(CreateBoolNode(True),CreateIntNode(0)); AssertNodeNotOK('Different node types',FN); end; procedure TTestBinaryOrNode.TestCreateString; begin FN:=TFPBinaryOrOperation.Create(CreateStringNode('True'),CreateStringNode('True')); AssertNodeNotOK('String node type',FN); end; procedure TTestBinaryOrNode.TestCreateFloat; begin FN:=TFPBinaryOrOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); AssertNodeNotOK('float node type',FN); end; procedure TTestBinaryOrNode.TestCreateDateTime; begin FN:=TFPBinaryOrOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now)); AssertNodeNotOK('DateTime node type',FN); end; procedure TTestBinaryOrNode.TestDestroy; begin FN:=TFPBinaryOrOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; { TTestBinaryXorNode } procedure TTestBinaryXorNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestBinaryXorNode.TestCreateInteger; begin FN:=TFPBinaryXorOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',3,FN.NodeValue.ResInteger); end; procedure TTestBinaryXorNode.TestCreateBoolean; begin FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateBoolNode(True)); AssertNodeOK(FN); AssertEquals('Correct node type',rtBoolean,FN.NodeType); AssertEquals('Correct result',False,FN.NodeValue.ResBoolean); end; procedure TTestBinaryXorNode.TestCreateBooleanInteger; begin FN:=TFPBinaryXorOperation.Create(CreateBoolNode(True),CreateIntNode(0)); AssertNodeNotOK('Different node types',FN); end; procedure TTestBinaryXorNode.TestCreateString; begin FN:=TFPBinaryXorOperation.Create(CreateStringNode('True'),CreateStringNode('True')); AssertNodeNotOK('String node type',FN); end; procedure TTestBinaryXorNode.TestCreateFloat; begin FN:=TFPBinaryXorOperation.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); AssertNodeNotOK('float node type',FN); end; procedure TTestBinaryXorNode.TestCreateDateTime; begin FN:=TFPBinaryXorOperation.Create(CreateDateTimeNode(Now),CreateDateTimeNode(Now)); AssertNodeNotOK('DateTime node type',FN); end; procedure TTestBinaryXorNode.TestDestroy; begin FN:=TFPBinaryXorOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; { TTestBooleanNode } procedure TTestBooleanNode.TestNode(B: TFPBooleanResultOperation; AResult: Boolean); begin AssertEquals(Format('Test %s(%s,%s) result',[B.ClassName,B.Left.AsString,B.Right.AsString]),Aresult,B.NodeValue.resBoolean); end; { TTestEqualNode } procedure TTestEqualNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; class function TTestEqualNode.NodeClass: TFPBooleanResultOperationClass; begin Result:=TFPEqualOperation; end; class function TTestEqualNode.ExpectedResult: Boolean; begin Result:=True end; class function TTestEqualNode.OperatorString: String; begin Result:='='; end; procedure TTestEqualNode.TestCreateIntegerEqual; begin FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,ExpectedResult); end; procedure TTestEqualNode.TestCreateIntegerUnEqual; begin FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not ExpectedResult); end; procedure TTestEqualNode.TestCreateFloatEqual; begin FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,ExpectedResult); end; procedure TTestEqualNode.TestCreateFloatUnEqual; begin FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.34)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not ExpectedResult); end; procedure TTestEqualNode.TestCreateStringEqual; begin FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now')); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,ExpectedResult); end; procedure TTestEqualNode.TestCreateStringUnEqual; begin FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then')); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not ExpectedResult); end; procedure TTestEqualNode.TestCreateBooleanEqual; begin FN:=NodeClass.Create(CreateBoolNode(True),CreateBoolNode(True)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,ExpectedResult); end; procedure TTestEqualNode.TestCreateBooleanUnEqual; begin FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(True)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not ExpectedResult); end; procedure TTestEqualNode.TestCreateDateTimeEqual; Var D : TDateTime; begin D:=Now; FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,ExpectedResult); end; procedure TTestEqualNode.TestCreateDateTimeUnEqual; Var D : TDateTime; begin D:=Now; FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not ExpectedResult); end; procedure TTestEqualNode.TestDestroy; begin FN:=NodeClass.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; procedure TTestEqualNode.TestWrongTypes1; begin FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestEqualNode.TestWrongTypes2; begin FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestEqualNode.TestWrongTypes3; begin FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestEqualNode.TestWrongTypes4; begin FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestEqualNode.TestWrongTypes5; begin FN:=NodeClass.Create(CreateFloatNode(1),CreateIntNode(1)); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestEqualNode.TestAsString; begin FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString); end; { TTestUnEqualNode } class function TTestUnEqualNode.NodeClass: TFPBooleanResultOperationClass; begin Result:=TFPUnEqualOperation; end; class function TTestUnEqualNode.ExpectedResult: Boolean; begin Result:=False; end; class function TTestUnEqualNode.OperatorString: String; begin Result:='<>'; end; { TTestLessThanNode } class function TTestLessThanNode.NodeClass: TFPBooleanResultOperationClass; begin Result:=TFPLessThanOperation; end; class function TTestLessThanNode.Larger: Boolean; begin Result:=False; end; class function TTestLessThanNode.AllowEqual: Boolean; begin Result:=False; end; class function TTestLessThanNode.OperatorString: String; begin Result:='<'; end; procedure TTestLessThanNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestLessThanNode.TestCreateIntegerEqual; begin FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,AllowEqual); end; procedure TTestLessThanNode.TestCreateIntegerSmaller; begin FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not Larger); end; procedure TTestLessThanNode.TestCreateIntegerLarger; begin FN:=NodeClass.Create(CreateIntNode(2),CreateIntNode(1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Larger); end; procedure TTestLessThanNode.TestCreateFloatEqual; begin FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(1.23)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,AllowEqual); end; procedure TTestLessThanNode.TestCreateFloatSmaller; begin FN:=NodeClass.Create(CreateFloatNode(1.23),CreateFloatNode(4.56)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not Larger); end; procedure TTestLessThanNode.TestCreateFloatLarger; begin FN:=NodeClass.Create(CreateFloatNode(4.56),CreateFloatNode(1.23)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Larger); end; procedure TTestLessThanNode.TestCreateDateTimeEqual; Var D : TDateTime; begin D:=Now; FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,AllowEqual); end; procedure TTestLessThanNode.TestCreateDateTimeSmaller; Var D : TDateTime; begin D:=Now; FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D+1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not larger); end; procedure TTestLessThanNode.TestCreateDateTimeLarger; Var D : TDateTime; begin D:=Now; FN:=NodeClass.Create(CreateDateTimeNode(D),CreateDateTimeNode(D-1)); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,larger); end; procedure TTestLessThanNode.TestCreateStringEqual; begin FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('now')); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,AllowEqual); end; procedure TTestLessThanNode.TestCreateStringSmaller; begin FN:=NodeClass.Create(CreateStringNode('now'),CreateStringNode('then')); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Not Larger); end; procedure TTestLessThanNode.TestCreateStringLarger; begin FN:=NodeClass.Create(CreateStringNode('then'),CreateStringNode('now')); AssertNodeOk(FN); AssertEquals('Boolean result',rtBoolean,FN.NodeType); TestNode(FN,Larger); end; procedure TTestLessThanNode.TestWrongTypes1; begin FN:=NodeClass.Create(CreateIntNode(3),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestWrongTypes2; begin FN:=NodeClass.Create(CreateDateTimeNode(3),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestWrongTypes3; begin FN:=NodeClass.Create(CreateFloatNode(1.3),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestWrongTypes4; begin FN:=NodeClass.Create(CreateBoolNode(False),CreateStringNode('1.23')); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestWrongTypes5; begin FN:=NodeClass.Create(CreateFloatNode(1.23),CreateIntNode(1)); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestNoBoolean1; begin FN:=NodeClass.Create(CreateBoolNode(False),CreateIntNode(1)); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestNoBoolean2; begin FN:=NodeClass.Create(CreateIntNode(1),CreateBoolNode(False)); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestNoBoolean3; begin FN:=NodeClass.Create(CreateBoolNode(False),CreateBoolNode(False)); AssertNodeNotOk('Wrong Types',FN); end; procedure TTestLessThanNode.TestAsString; begin FN:=NodeClass.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Asstring works ok','1 '+OPeratorString+' 2',FN.AsString); end; { TTestLessThanEqualNode } class function TTestLessThanEqualNode.NodeClass: TFPBooleanResultOperationClass; begin Result:=TFPLessThanEqualOperation; end; class function TTestLessThanEqualNode.AllowEqual: Boolean; begin Result:=True; end; class function TTestLessThanEqualNode.OperatorString: String; begin Result:='<='; end; { TTestLargerThanNode } class function TTestLargerThanNode.NodeClass: TFPBooleanResultOperationClass; begin Result:=TFPGreaterThanOperation; end; class function TTestLargerThanNode.Larger: Boolean; begin Result:=True; end; class function TTestLargerThanNode.OperatorString: String; begin Result:='>'; end; { TTestLargerThanEqualNode } class function TTestLargerThanEqualNode.NodeClass: TFPBooleanResultOperationClass; begin Result:=TFPGreaterThanEqualOperation; end; class function TTestLargerThanEqualNode.AllowEqual: Boolean; begin Result:=True; end; class function TTestLargerThanEqualNode.OperatorString: String; begin Result:='>='; end; { TTestAddNode } procedure TTestAddNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestAddNode.TestCreateInteger; begin FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Add has correct type',rtInteger,FN.NodeType); AssertEquals('Add has correct result',3,FN.NodeValue.ResInteger); end; procedure TTestAddNode.TestCreateFloat; begin FN:=TFPAddOperation.Create(CreateFloatNode(1.23),CreateFloatNode(4.56)); AssertEquals('Add has correct type',rtFloat,FN.NodeType); AssertEquals('Add has correct result',5.79,FN.NodeValue.ResFloat); end; procedure TTestAddNode.TestCreateDateTime; Var D,T : TDateTime; begin D:=Date; T:=Time; FN:=TFPAddOperation.Create(CreateDateTimeNode(D),CreateDateTimeNode(T)); AssertEquals('Add has correct type',rtDateTime,FN.NodeType); AssertEquals('Add has correct result',D+T,FN.NodeValue.ResDateTime); end; procedure TTestAddNode.TestCreateString; begin FN:=TFPAddOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); AssertEquals('Add has correct type',rtString,FN.NodeType); AssertEquals('Add has correct result','aloha',FN.NodeValue.ResString); end; procedure TTestAddNode.TestCreateBoolean; begin FN:=TFPAddOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); AssertNodeNotOK('No boolean addition',FN); end; procedure TTestAddNode.TestDestroy; begin FN:=TFPAddOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; procedure TTestAddNode.TestAsString; begin FN:=TFPAddOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Asstring works ok','1 + 2',FN.AsString); end; { TTestSubtractNode } procedure TTestSubtractNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestSubtractNode.TestCreateInteger; begin FN:=TFPSubtractOperation.Create(CreateIntNode(4),CreateIntNode(1)); AssertEquals('Subtract has correct type',rtInteger,FN.NodeType); AssertEquals('Subtract has correct result',3,FN.NodeValue.ResInteger); end; procedure TTestSubtractNode.TestCreateFloat; begin FN:=TFPSubtractOperation.Create(CreateFloatNode(4.56),CreateFloatNode(1.23)); AssertEquals('Subtract has correct type',rtFloat,FN.NodeType); AssertEquals('Subtract has correct result',3.33,FN.NodeValue.ResFloat); end; procedure TTestSubtractNode.TestCreateDateTime; Var D,T : TDateTime; begin D:=Date; T:=Time; FN:=TFPSubtractOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T)); AssertEquals('Subtract has correct type',rtDateTime,FN.NodeType); AssertEquals('Subtract has correct result',D,FN.NodeValue.ResDateTime); end; procedure TTestSubtractNode.TestCreateString; begin FN:=TFPSubtractOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); AssertNodeNotOK('No string Subtract',FN); end; procedure TTestSubtractNode.TestCreateBoolean; begin FN:=TFPSubtractOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); AssertNodeNotOK('No boolean Subtract',FN); end; procedure TTestSubtractNode.TestDestroy; begin FN:=TFPSubtractOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; procedure TTestSubtractNode.TestAsString; begin FN:=TFPSubtractOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Asstring works ok','1 - 2',FN.AsString); end; { TTestMultiplyNode } procedure TTestMultiplyNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestMultiplyNode.TestCreateInteger; begin FN:=TFPMultiplyOperation.Create(CreateIntNode(4),CreateIntNode(2)); AssertEquals('multiply has correct type',rtInteger,FN.NodeType); AssertEquals('multiply has correct result',8,FN.NodeValue.ResInteger); end; procedure TTestMultiplyNode.TestCreateFloat; begin FN:=TFPMultiplyOperation.Create(CreateFloatNode(2.0),CreateFloatNode(1.23)); AssertEquals('multiply has correct type',rtFloat,FN.NodeType); AssertEquals('multiply has correct result',2.46,FN.NodeValue.ResFloat); end; procedure TTestMultiplyNode.TestCreateDateTime; Var D,T : TDateTime; begin D:=Date; T:=Time; FN:=TFPMultiplyOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T)); AssertNodeNotOK('No datetime multiply',FN); end; procedure TTestMultiplyNode.TestCreateString; begin FN:=TFPMultiplyOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); AssertNodeNotOK('No string multiply',FN); end; procedure TTestMultiplyNode.TestCreateBoolean; begin FN:=TFPMultiplyOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); AssertNodeNotOK('No boolean multiply',FN); end; procedure TTestMultiplyNode.TestDestroy; begin FN:=TFPMultiplyOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; procedure TTestMultiplyNode.TestAsString; begin FN:=TFPMultiplyOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Asstring works ok','1 * 2',FN.AsString); end; { TTestDivideNode } procedure TTestDivideNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestDivideNode.TestCreateInteger; begin FN:=TFPDivideOperation.Create(CreateIntNode(4),CreateIntNode(2)); AssertEquals('Divide has correct type',rtfloat,FN.NodeType); AssertEquals('Divide has correct result',2.0,FN.NodeValue.ResFloat); end; procedure TTestDivideNode.TestCreateFloat; begin FN:=TFPDivideOperation.Create(CreateFloatNode(9.0),CreateFloatNode(3.0)); AssertEquals('Divide has correct type',rtFloat,FN.NodeType); AssertEquals('Divide has correct result',3.0,FN.NodeValue.ResFloat); end; procedure TTestDivideNode.TestCreateDateTime; Var D,T : TDateTime; begin D:=Date; T:=Time; FN:=TFPDivideOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T)); AssertNodeNotOK('No datetime division',FN); end; procedure TTestDivideNode.TestCreateString; begin FN:=TFPDivideOperation.Create(CreateStringNode('alo'),CreateStringNode('ha')); AssertNodeNotOK('No string division',FN); end; procedure TTestDivideNode.TestCreateBoolean; begin FN:=TFPDivideOperation.Create(CreateBoolNode(True),CreateBoolNode(False)); AssertNodeNotOK('No boolean division',FN); end; procedure TTestDivideNode.TestDestroy; begin FN:=TFPDivideOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled) end; procedure TTestDivideNode.TestAsString; begin FN:=TFPDivideOperation.Create(CreateIntNode(1),CreateIntNode(2)); AssertEquals('Asstring works ok','1 / 2',FN.AsString); end; { TTestIntToFloatNode } procedure TTestIntToFloatNode.TearDown; begin FreeAndNil(Fn); inherited TearDown; end; procedure TTestIntToFloatNode.TestCreateInteger; begin FN:=TIntToFloatNode.Create(CreateIntNode(4)); AssertEquals('Convert has correct type',rtfloat,FN.NodeType); AssertEquals('Convert has correct result',4.0,FN.NodeValue.ResFloat); end; procedure TTestIntToFloatNode.TestCreateFloat; begin FN:=TIntToFloatNode.Create(CreateFloatNode(4.0)); AssertNodeNotOK('No float allowed',FN); end; procedure TTestIntToFloatNode.TestDestroy; begin FN:=TIntToFloatNode.Create(TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled) end; procedure TTestIntToFloatNode.TestAsString; begin FN:=TIntToFloatNode.Create(CreateIntNode(4)); AssertEquals('Convert has correct asstring','4',FN.AsString); end; { TTestIntToDateTimeNode } procedure TTestIntToDateTimeNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestIntToDateTimeNode.TestCreateInteger; begin FN:=TIntToDateTimeNode.Create(CreateIntNode(Round(Date))); AssertEquals('Convert has correct type',rtDateTime,FN.NodeType); AssertEquals('Convert has correct result',Date,FN.NodeValue.ResDateTime); end; procedure TTestIntToDateTimeNode.TestCreateFloat; begin FN:=TIntToDateTimeNode.Create(CreateFloatNode(4.0)); AssertNodeNotOK('No float allowed',FN); end; procedure TTestIntToDateTimeNode.TestDestroy; begin FN:=TIntToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled) end; procedure TTestIntToDateTimeNode.TestAsString; begin FN:=TIntToDateTimeNode.Create(CreateIntNode(4)); AssertEquals('Convert has correct asstring','4',FN.AsString); end; { TTestFloatToDateTimeNode } procedure TTestFloatToDateTimeNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestFloatToDateTimeNode.TestCreateInteger; begin FN:=TFloatToDateTimeNode.Create(CreateIntNode(4)); AssertNodeNotOK('No int allowed',FN); end; procedure TTestFloatToDateTimeNode.TestCreateFloat; Var T : TExprFloat; begin T:=Time; FN:=TFloatToDateTimeNode.Create(CreateFloatNode(T)); AssertEquals('Convert has correct type',rtDateTime,FN.NodeType); AssertEquals('Convert has correct result',T,FN.NodeValue.ResDateTime); end; procedure TTestFloatToDateTimeNode.TestDestroy; begin FN:=TFloatToDateTimeNode.Create(TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for left and right nodes',1,self.FDestroyCalled) end; procedure TTestFloatToDateTimeNode.TestAsString; Var S : String; begin FN:=TFloatToDateTimeNode.Create(CreateFloatNode(1.2)); Str(TExprFloat(1.2),S); AssertEquals('Convert has correct asstring',S,FN.AsString); end; { TMyFPExpressionParser } procedure TMyFPExpressionParser.BuildHashList; begin CreateHashList; end; { TTestExpressionParser } procedure TTestExpressionParser.SetUp; begin inherited SetUp; FP:=TMyFPExpressionParser.Create(Nil); end; procedure TTestExpressionParser.TearDown; begin FreeAndNil(FP); inherited TearDown; end; procedure TTestExpressionParser.DoParse; begin FP.Expression:=FTestExpr; end; procedure TTestExpressionParser.TestParser(AExpr : string); begin FTestExpr:=AExpr; AssertException(Format('Wrong expression: "%s"',[AExpr]),EExprParser,@DoParse); end; procedure TTestExpressionParser.AssertLeftRight(N: TFPExprNode; LeftClass, RightClass: TClass); begin AssertNotNull('Binary node not null',N); If Not N.InheritsFrom(TFPBinaryOperation) then Fail(N.ClassName+' does not descend from TFPBinaryOperation'); AssertNotNull('Left node assigned',TFPBinaryOperation(N).Left); AssertNotNull('Right node assigned',TFPBinaryOperation(N).Right); AssertEquals('Left node correct class ',LeftClass, TFPBinaryOperation(N).Left.ClassType); AssertEquals('Right node correct class ',RightClass, TFPBinaryOperation(N).Right.ClassType); end; procedure TTestExpressionParser.AssertOperand(N: TFPExprNode; OperandClass: TClass); begin AssertNotNull('Unary node not null',N); If Not N.InheritsFrom(TFPUnaryOperator) then Fail(N.ClassName+' does not descend from TFPUnaryOperator'); AssertNotNull('Operand assigned',TFPUnaryOperator(N).Operand); AssertEquals('Operand node correct class ',OperandClass, TFPUnaryOperator(N).Operand.ClassType); end; procedure TTestExpressionParser.AssertResultType(RT: TResultType); begin AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ExprNode); AssertEquals('Result type is '+ResultTypeName(rt),rt,FP.ResultType); end; procedure TTestExpressionParser.AssertResult(F: TExprFloat); begin AssertEquals('Correct float result',F,FP.ExprNode.NodeValue.ResFloat); AssertEquals('Correct float result',F,FP.Evaluate.ResFloat); end; procedure TTestExpressionParser.AssertResult(I: Int64); begin AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger); AssertEquals('Correct integer result',I,FP.Evaluate.ResInteger); end; procedure TTestExpressionParser.AssertResult(S: String); begin AssertEquals('Correct string result',S,FP.ExprNode.NodeValue.ResString); AssertEquals('Correct string result',S,FP.Evaluate.ResString); end; procedure TTestExpressionParser.AssertResult(B: Boolean); begin AssertEquals('Correct boolean result',B,FP.ExprNode.NodeValue.ResBoolean); AssertEquals('Correct boolean result',B,FP.Evaluate.ResBoolean); end; procedure TTestExpressionParser.AssertDateTimeResult(D: TDateTime); begin AssertEquals('Correct datetime result',D,FP.ExprNode.NodeValue.ResDateTime); AssertEquals('Correct boolean result',D,FP.Evaluate.ResDateTime); end; //TTestParserExpressions procedure TTestParserExpressions.TestCreate; begin AssertEquals('Expression is empty','',FP.Expression); AssertNotNull('Identifiers assigned',FP.Identifiers); AssertEquals('No identifiers',0,FP.Identifiers.Count); end; procedure TTestParserExpressions.TestSimpleNodeFloat; begin FP.Expression:='123.4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); AssertResultType(rtFloat); AssertResult(123.4); end; procedure TTestParserExpressions.TestSimpleNodeInteger; begin FP.Expression:='1234'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); AssertResultType(rtInteger); AssertResult(1234); end; procedure TTestParserExpressions.TestSimpleNodeBooleanTrue; begin FP.Expression:='true'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserExpressions.TestSimpleNodeBooleanFalse; begin FP.Expression:='False'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserExpressions.TestSimpleNodeString; begin FP.Expression:='''A string'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, FP.ExprNode); AssertResultType(rtString); AssertResult('A string'); end; procedure TTestParserExpressions.TestSimpleNegativeInteger; begin FP.Expression:='-1234'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand); AssertResultType(rtInteger); AssertResult(-1234); end; procedure TTestParserExpressions.TestSimpleNegativeFloat; begin FP.Expression:='-1.234'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPNegateOperation, FP.ExprNode); AssertNodeType('Constant expression',TFPConstExpression, TFPNegateOperation(FP.ExprNode).Operand); AssertResultType(rtFloat); AssertResult(-1.234); end; procedure TTestParserExpressions.TestSimpleAddInteger; begin FP.Expression:='4+1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(5); end; procedure TTestParserExpressions.TestSimpleAddFloat; begin FP.Expression:='1.2+3.4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtFloat); AssertResult(4.6); end; procedure TTestParserExpressions.TestSimpleAddIntegerFloat; begin FP.Expression:='1+3.4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TIntToFLoatNode,TFPConstExpression); AssertResultType(rtFloat); AssertResult(4.4); end; procedure TTestParserExpressions.TestSimpleAddFloatInteger; begin FP.Expression:='3.4 + 1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFLoatNode); AssertResultType(rtFloat); AssertResult(4.4); end; procedure TTestParserExpressions.TestSimpleAddString; begin FP.Expression:='''alo''+''ha'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtString); AssertResult('aloha'); end; procedure TTestParserExpressions.TestSimpleSubtractInteger; begin FP.Expression:='4-1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(3); end; procedure TTestParserExpressions.TestSimpleSubtractFloat; begin FP.Expression:='3.4-1.2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtFloat); AssertResult(2.2); end; procedure TTestParserExpressions.TestSimpleSubtractIntegerFloat; begin FP.Expression:='3-1.2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TIntToFloatNode,TFPConstExpression); AssertResultType(rtFloat); AssertResult(1.8); end; procedure TTestParserExpressions.TestSimpleSubtractFloatInteger; begin FP.Expression:='3.3-2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TIntToFloatNode); AssertResultType(rtFloat); AssertResult(1.3); end; procedure TTestParserExpressions.TestSimpleMultiplyInteger; begin FP.Expression:='4*2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(8); end; procedure TTestParserExpressions.TestSimpleMultiplyFloat; begin FP.Expression:='3.4*1.5'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtFloat); AssertResult(5.1); end; procedure TTestParserExpressions.TestSimpleDivideInteger; begin FP.Expression:='4/2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtFloat); AssertResult(2.0); end; procedure TTestParserExpressions.TestSimpleDivideFloat; begin FP.Expression:='5.1/1.5'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPDivideOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtFloat); AssertResult(3.4); end; procedure TTestParserExpressions.TestSimpleBooleanAnd; begin FP.Expression:='true and true'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserExpressions.TestSimpleIntegerAnd; begin FP.Expression:='3 and 1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(1); end; procedure TTestParserExpressions.TestSimpleBooleanOr; begin FP.Expression:='false or true'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserExpressions.TestSimpleIntegerOr; begin FP.Expression:='2 or 1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(3); end; procedure TTestParserExpressions.TestSimpleBooleanNot; begin FP.Expression:='not false'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Not node',TFPNotNode, FP.ExprNode); AssertOperand(FP.ExprNode,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(true); end; procedure TTestParserExpressions.TestSimpleIntegerNot; begin FP.Expression:='Not 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Not node',TFPNotNode, FP.ExprNode); AssertOperand(FP.ExprNode,TFPConstExpression); AssertResultType(rtInteger); AssertResult(Not Int64(3)); end; procedure TTestParserExpressions.TestSimpleAddSeries; begin FP.Expression:='1 + 2 + 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression); AssertResultType(rtInteger); AssertResult(6); end; procedure TTestParserExpressions.TestSimpleMultiplySeries; begin FP.Expression:='2 * 3 * 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression); AssertResultType(rtInteger); AssertResult(24); end; procedure TTestParserExpressions.TestSimpleAddMultiplySeries; begin FP.Expression:='2 * 3 + 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPConstExpression); AssertResultType(rtInteger); AssertResult(10); end; procedure TTestParserExpressions.TestSimpleAddAndSeries; begin // 2 and (3+4) FP.Expression:='2 and 3 + 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation); AssertResultType(rtInteger); AssertResult(2); end; procedure TTestParserExpressions.TestSimpleAddOrSeries; begin // 2 or (3+4) FP.Expression:='2 or 3 + 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation); AssertResultType(rtInteger); AssertResult(7); end; procedure TTestParserExpressions.TestSimpleOrNotSeries; begin FP.Expression:='Not 1 or 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression); AssertResultType(rtInteger); AssertResult((Not Int64(1)) or Int64(3)); end; procedure TTestParserExpressions.TestSimpleAndNotSeries; begin FP.Expression:='Not False and False'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPNotNode,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserExpressions.TestDoubleAddMultiplySeries; begin FP.Expression:='2 * 3 + 4 * 5'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation); AssertResultType(rtInteger); AssertResult(26); end; procedure TTestParserExpressions.TestDoubleSubtractMultiplySeries; begin FP.Expression:='4 * 5 - 2 * 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPSubtractOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPMultiplyOperation,TFPMultiplyOperation); AssertResultType(rtInteger); AssertResult(14); end; procedure TTestParserExpressions.TestSimpleIfInteger; begin FP.Expression:='If(True,1,2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('If operation',TIfOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(1); end; procedure TTestParserExpressions.TestSimpleIfString; begin FP.Expression:='If(True,''a'',''b'')'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('If operation',TIfOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtString); AssertResult('a'); end; procedure TTestParserExpressions.TestSimpleIfFloat; begin FP.Expression:='If(True,1.2,3.4)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('If operation',TIfOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtFloat); AssertResult(1.2); end; procedure TTestParserExpressions.TestSimpleIfBoolean; begin FP.Expression:='If(True,False,True)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('If operation',TIfOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserExpressions.TestSimpleIfDateTime; begin FP.Identifiers.AddDateTimeVariable('a',Date); FP.Identifiers.AddDateTimeVariable('b',Date-1); FP.Expression:='If(True,a,b)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('If operation',TIfOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPExprVariable,TFPExprVariable); AssertResultType(rtDateTime); AssertResult(Date); end; procedure TTestParserExpressions.TestSimpleIfOperation; begin FP.Expression:='If(True,''a'',''b'')+''c'''; AssertNotNull('Have result node',FP.ExprNode); AssertResultType(rtString); AssertResult('ac'); end; procedure TTestParserExpressions.TestSimpleBrackets; begin FP.Expression:='(4 + 2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPAddOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(6); end; procedure TTestParserExpressions.TestSimpleBrackets2; begin FP.Expression:='(4 * 2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtInteger); AssertResult(8); end; procedure TTestParserExpressions.TestSimpleBracketsLeft; begin FP.Expression:='(4 + 2) * 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPConstExpression); AssertResultType(rtInteger); AssertResult(18); end; procedure TTestParserExpressions.TestSimpleBracketsRight; begin FP.Expression:='3 * (4 + 2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPAddOperation); AssertResultType(rtInteger); AssertResult(18); end; procedure TTestParserExpressions.TestSimpleBracketsDouble; begin FP.Expression:='(3 + 4) * (4 + 2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPMultiplyOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPAddOperation,TFPAddOperation); AssertResultType(rtInteger); AssertResult(42); end; //TTestParserBooleanOperations procedure TTestParserBooleanOperations.TestEqualInteger; begin FP.Expression:='1 = 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestUnEqualInteger; begin FP.Expression:='1 <> 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestEqualFloat; begin FP.Expression:='1.2 = 2.3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestEqualFloat2; begin FP.Expression:='1.2 = 1.2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestUnEqualFloat; begin FP.Expression:='1.2 <> 2.3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestEqualString; begin FP.Expression:='''1.2'' = ''2.3'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestEqualString2; begin FP.Expression:='''1.2'' = ''1.2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestUnEqualString; begin FP.Expression:='''1.2'' <> ''2.3'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestUnEqualString2; begin FP.Expression:='''aa'' <> ''AA'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestEqualBoolean; begin FP.Expression:='False = True'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestUnEqualBoolean; begin FP.Expression:='False <> True'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPUnEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestLessThanInteger; begin FP.Expression:='1 < 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestLessThanInteger2; begin FP.Expression:='2 < 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestLessThanEqualInteger; begin FP.Expression:='3 <= 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestLessThanEqualInteger2; begin FP.Expression:='2 <= 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestLessThanFloat; begin FP.Expression:='1.2 < 2.3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestLessThanFloat2; begin FP.Expression:='2.2 < 2.2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestLessThanEqualFloat; begin FP.Expression:='3.1 <= 2.1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestLessThanEqualFloat2; begin FP.Expression:='2.1 <= 2.1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestLessThanString; begin FP.Expression:='''1'' < ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestLessThanString2; begin FP.Expression:='''2'' < ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestLessThanEqualString; begin FP.Expression:='''3'' <= ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestLessThanEqualString2; begin FP.Expression:='''2'' <= ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPLessThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestGreaterThanInteger; begin FP.Expression:='1 > 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestGreaterThanInteger2; begin FP.Expression:='2 > 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger; begin FP.Expression:='3 >= 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestGreaterThanEqualInteger2; begin FP.Expression:='2 >= 2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestGreaterThanFloat; begin FP.Expression:='1.2 > 2.3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestGreaterThanFloat2; begin FP.Expression:='2.2 > 2.2'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat; begin FP.Expression:='3.1 >= 2.1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestGreaterThanEqualFloat2; begin FP.Expression:='2.1 >= 2.1'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestGreaterThanString; begin FP.Expression:='''1'' > ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestGreaterThanString2; begin FP.Expression:='''2'' > ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.TestGreaterThanEqualString; begin FP.Expression:='''3'' >= ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.TestGreaterThanEqualString2; begin FP.Expression:='''2'' >= ''2'''; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPGreaterThanEqualOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPConstExpression,TFPConstExpression); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.EqualAndSeries; begin // (1=2) and (3=4) FP.Expression:='1 = 2 and 3 = 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.EqualAndSeries2; begin // (1=2) and (3=4) FP.Expression:='1 = 1 and 3 = 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.EqualOrSeries; begin // (1=2) or (3=4) FP.Expression:='1 = 2 or 3 = 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.EqualOrSeries2; begin // (1=1) or (3=4) FP.Expression:='1 = 1 or 3 = 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPEqualOperation,TFPEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.UnEqualAndSeries; begin // (1<>2) and (3<>4) FP.Expression:='1 <> 2 and 3 <> 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.UnEqualAndSeries2; begin // (1<>2) and (3<>4) FP.Expression:='1 <> 1 and 3 <> 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.UnEqualOrSeries; begin // (1<>2) or (3<>4) FP.Expression:='1 <> 2 or 3 <> 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.UnEqualOrSeries2; begin // (1<>1) or (3<>4) FP.Expression:='1 <> 1 or 3 <> 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPUnEqualOperation,TFPUnEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.LessThanAndSeries; begin // (1<2) and (3<4) FP.Expression:='1 < 2 and 3 < 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.LessThanAndSeries2; begin // (1<2) and (3<4) FP.Expression:='1 < 1 and 3 < 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.LessThanOrSeries; begin // (1<2) or (3<4) FP.Expression:='1 < 2 or 3 < 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.LessThanOrSeries2; begin // (1<1) or (3<4) FP.Expression:='1 < 1 or 3 < 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanOperation,TFPLessThanOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.GreaterThanAndSeries; begin // (1>2) and (3>4) FP.Expression:='1 > 2 and 3 > 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.GreaterThanAndSeries2; begin // (1>2) and (3>4) FP.Expression:='1 > 1 and 3 > 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.GreaterThanOrSeries; begin // (1>2) or (3>4) FP.Expression:='1 > 2 or 3 > 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.GreaterThanOrSeries2; begin // (1>1) or (3>4) FP.Expression:='1 > 1 or 3 > 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanOperation,TFPGreaterThanOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.LessThanEqualAndSeries; begin // (1<=2) and (3<=4) FP.Expression:='1 <= 2 and 3 <= 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.LessThanEqualAndSeries2; begin // (1<=2) and (3<=4) FP.Expression:='1 <= 1 and 3 <= 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.LessThanEqualOrSeries; begin // (1<=2) or (3<=4) FP.Expression:='1 <= 2 or 3 <= 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.LessThanEqualOrSeries2; begin // (1<=1) or (3<=4) FP.Expression:='1 <= 1 or 3 <= 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPLessThanEqualOperation,TFPLessThanEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries; begin // (1>=2) and (3>=4) FP.Expression:='1 >= 2 and 3 >= 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.GreaterThanEqualAndSeries2; begin // (1>=2) and (3>=4) FP.Expression:='1 >= 1 and 3 >= 3'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryAndOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries; begin // (1>=2) or (3>=4) FP.Expression:='1 >= 2 or 3 >= 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); AssertResultType(rtBoolean); AssertResult(False); end; procedure TTestParserBooleanOperations.GreaterThanEqualOrSeries2; begin // (1>=1) or (3>=4) FP.Expression:='1 >= 1 or 3 >= 4'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPBinaryOrOperation, FP.ExprNode); AssertLeftRight(FP.ExprNode,TFPGreaterThanEqualOperation,TFPGreaterThanEqualOperation); AssertResultType(rtBoolean); AssertResult(True); end; //TTestParserOperands procedure TTestParserOperands.MissingOperand1; begin TestParser('1+'); end; procedure TTestParserOperands.MissingOperand2; begin TestParser('*1'); end; procedure TTestParserOperands.MissingOperand3; begin TestParser('1*'); end; procedure TTestParserOperands.MissingOperand4; begin TestParser('1+'); end; procedure TTestParserOperands.MissingOperand5; begin TestParser('1 and'); end; procedure TTestParserOperands.MissingOperand6; begin TestParser('1 or'); end; procedure TTestParserOperands.MissingOperand7; begin TestParser('and 1'); end; procedure TTestParserOperands.MissingOperand8; begin TestParser('or 1'); end; procedure TTestParserOperands.MissingOperand9; begin TestParser('1-'); end; procedure TTestParserOperands.MissingOperand10; begin TestParser('1 = '); end; procedure TTestParserOperands.MissingOperand11; begin TestParser('= 1'); end; procedure TTestParserOperands.MissingOperand12; begin TestParser('1 <> '); end; procedure TTestParserOperands.MissingOperand13; begin TestParser('<> 1'); end; procedure TTestParserOperands.MissingOperand14; begin TestParser('1 >= '); end; procedure TTestParserOperands.MissingOperand15; begin TestParser('>= 1'); end; procedure TTestParserOperands.MissingOperand16; begin TestParser('1 <= '); end; procedure TTestParserOperands.MissingOperand17; begin TestParser('<= 1'); end; procedure TTestParserOperands.MissingOperand18; begin TestParser('1 < '); end; procedure TTestParserOperands.MissingOperand19; begin TestParser('< 1'); end; procedure TTestParserOperands.MissingOperand20; begin TestParser('1 > '); end; procedure TTestParserOperands.MissingOperand21; begin TestParser('> 1'); end; procedure TTestParserOperands.MissingBracket1; begin TestParser('(1+3'); end; procedure TTestParserOperands.MissingBracket2; begin TestParser('1+3)'); end; procedure TTestParserOperands.MissingBracket3; begin TestParser('(1+3))'); end; procedure TTestParserOperands.MissingBracket4; begin TestParser('((1+3)'); end; procedure TTestParserOperands.MissingBracket5; begin TestParser('((1+3) 4'); end; procedure TTestParserOperands.MissingBracket6; begin TestParser('IF(true,1,2'); end; procedure TTestParserOperands.MissingBracket7; begin TestParser('case(1,1,2,4'); end; procedure TTestParserOperands.MissingArgument1; begin TestParser('IF(true,1)'); end; procedure TTestParserOperands.MissingArgument2; begin TestParser('IF(True)'); end; procedure TTestParserOperands.MissingArgument3; begin TestParser('case(1)'); end; procedure TTestParserOperands.MissingArgument4; begin TestParser('case(1,2)'); end; procedure TTestParserOperands.MissingArgument5; begin TestParser('case(1,2,3)'); end; procedure TTestParserOperands.MissingArgument6; begin TestParser('IF(true,1,2,3)'); end; procedure TTestParserOperands.MissingArgument7; begin TestParser('case(0,1,2,3,4,5,6)'); end; procedure TTestParserTypeMatch.AccessString; begin FP.AsString; end; procedure TTestParserTypeMatch.AccessInteger; begin FP.AsInteger; end; procedure TTestParserTypeMatch.AccessFloat; begin FP.AsFloat; end; procedure TTestParserTypeMatch.AccessDateTime; begin FP.AsDateTime; end; procedure TTestParserTypeMatch.AccessBoolean; begin FP.AsBoolean; end; //TTestParserTypeMatch procedure TTestParserTypeMatch.TestTypeMismatch1; begin TestParser('1+''string'''); end; procedure TTestParserTypeMatch.TestTypeMismatch2; begin TestParser('1+True'); end; procedure TTestParserTypeMatch.TestTypeMismatch3; begin TestParser('True+''string'''); end; procedure TTestParserTypeMatch.TestTypeMismatch4; begin TestParser('1.23+''string'''); end; procedure TTestParserTypeMatch.TestTypeMismatch5; begin TestParser('1.23+true'); end; procedure TTestParserTypeMatch.TestTypeMismatch6; begin TestParser('1.23 and true'); end; procedure TTestParserTypeMatch.TestTypeMismatch7; begin TestParser('1.23 or true'); end; procedure TTestParserTypeMatch.TestTypeMismatch8; begin TestParser('''string'' or true'); end; procedure TTestParserTypeMatch.TestTypeMismatch9; begin TestParser('''string'' and true'); end; procedure TTestParserTypeMatch.TestTypeMismatch10; begin TestParser('1.23 or 1'); end; procedure TTestParserTypeMatch.TestTypeMismatch11; begin TestParser('1.23 and 1'); end; procedure TTestParserTypeMatch.TestTypeMismatch12; begin TestParser('''astring'' = 1'); end; procedure TTestParserTypeMatch.TestTypeMismatch13; begin TestParser('true = 1'); end; procedure TTestParserTypeMatch.TestTypeMismatch14; begin TestParser('true * 1'); end; procedure TTestParserTypeMatch.TestTypeMismatch15; begin TestParser('''astring'' * 1'); end; procedure TTestParserTypeMatch.TestTypeMismatch16; begin TestParser('If(1,1,1)'); end; procedure TTestParserTypeMatch.TestTypeMismatch17; begin TestParser('If(True,1,''3'')'); end; procedure TTestParserTypeMatch.TestTypeMismatch18; begin TestParser('case(1,1,''3'',1)'); end; procedure TTestParserTypeMatch.TestTypeMismatch19; begin TestParser('case(1,1,1,''3'')'); end; procedure TTestParserTypeMatch.TestTypeMismatch20; begin FP.Expression:='1'; AssertException('Accessing integer as string',EExprParser,@AccessString); end; procedure TTestParserTypeMatch.TestTypeMismatch21; begin FP.Expression:='''a'''; AssertException('Accessing string as integer',EExprParser,@AccessInteger); end; procedure TTestParserTypeMatch.TestTypeMismatch22; begin FP.Expression:='''a'''; AssertException('Accessing string as float',EExprParser,@AccessFloat); end; procedure TTestParserTypeMatch.TestTypeMismatch23; begin FP.Expression:='''a'''; AssertException('Accessing string as boolean',EExprParser,@AccessBoolean); end; procedure TTestParserTypeMatch.TestTypeMismatch24; begin FP.Expression:='''a'''; AssertException('Accessing string as datetime',EExprParser,@AccessDateTime); end; //TTestParserVariables Procedure GetDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resDateTime:=Date; end; procedure TTestParserVariables.TestVariable1; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddVariable('a',rtBoolean,'True'); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); AssertEquals('Variable has correct value','True',I.Value); end; procedure TTestParserVariables.TestVariable2; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddBooleanVariable('a',False); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); AssertEquals('Variable has correct value','False',I.Value); end; procedure TTestParserVariables.TestVariable3; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',123); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType); AssertEquals('Variable has correct value','123',I.Value); end; procedure TTestParserVariables.TestVariable4; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFloatVariable('a',1.23); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType); AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value); end; procedure TTestParserVariables.TestVariable5; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddStringVariable('a','1.23'); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Variable has correct resulttype',rtString,I.ResultType); AssertEquals('Variable has correct value','1.23',I.Value); end; procedure TTestParserVariables.TestVariable6; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Now; I:=FP.Identifiers.AddDateTimeVariable('a',D); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType); AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value); end; procedure TTestParserVariables.AddVariabletwice; begin FP.Identifiers.AddDateTimeVariable('a',Now); end; procedure TTestParserVariables.UnknownVariable; begin FP.Identifiers.IdentifierByName('unknown'); end; procedure TTestParserVariables.ReadWrongType; Var Res : TFPExpressioNResult; begin AssertEquals('Only one identifier',1,FP.Identifiers.Count); Case FAsWrongType of rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean; rtString : res.ResString:=FP.Identifiers[0].AsString; rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger; rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat; rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime; end; end; procedure TTestParserVariables.WriteWrongType; Var Res : TFPExpressioNResult; begin AssertEquals('Only one identifier',1,FP.Identifiers.Count); Case FAsWrongType of rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean; rtString : FP.Identifiers[0].AsString:=res.ResString; rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger; rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat; rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime; end; end; procedure TTestParserVariables.DoDummy(var Result: TFPExpressionResult; const Args: TExprParameterArray); begin // Do nothing; end; procedure TTestParserVariables.TestVariableAssign; Var I,J : TFPExprIdentifierDef; begin I:=TFPExprIdentifierDef.Create(Nil); try J:=TFPExprIdentifierDef.Create(Nil); try I.Name:='Aname'; I.ParameterTypes:='ISDBF'; I.ResultType:=rtFloat; I.Value:='1.23'; I.OnGetFunctionValue:=@DoDummy; I.OnGetFunctionValueCallBack:=@GetDate; J.Assign(I); AssertEquals('Names match',I.Name,J.Name); AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes); AssertEquals('Values match',I.Value,J.Value); AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType)); AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback)); If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then Fail('OnGetFUnctionValue as Method does not match'); finally J.Free; end; finally I.Free; end; end; procedure TTestParserVariables.TestVariableAssignAgain; Var I,J : TFPBuiltinExprIdentifierDef; begin I:=TFPBuiltinExprIdentifierDef.Create(Nil); try J:=TFPBuiltinExprIdentifierDef.Create(Nil); try I.Name:='Aname'; I.ParameterTypes:='ISDBF'; I.ResultType:=rtFloat; I.Value:='1.23'; I.OnGetFunctionValue:=@DoDummy; I.OnGetFunctionValueCallBack:=@GetDate; I.Category:=bcUser; J.Assign(I); AssertEquals('Names match',I.Name,J.Name); AssertEquals('Parametertypes match',I.ParameterTypes,J.ParameterTypes); AssertEquals('Values match',I.Value,J.Value); AssertEquals('Result types match',Ord(I.ResultType),Ord(J.ResultType)); AssertEquals('Categories match',Ord(I.Category),Ord(J.Category)); AssertSame('Callbacks match',Pointer(I.OnGetFunctionValueCallBack),Pointer(J.OnGetFunctionValueCallback)); If (I.OnGetFunctionValue)<>(J.OnGetFunctionValue) then Fail('OnGetFUnctionValue as Method does not match'); finally J.Free; end; finally I.Free; end; end; procedure TTestParserVariables.TestVariable7; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Now; I:=FP.Identifiers.AddDateTimeVariable('a',D); AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice); end; procedure TTestParserVariables.TestVariable8; Var I : TFPExprIdentifierDef; begin FP.Identifiers.AddIntegerVariable('a',123); FP.Identifiers.AddIntegerVariable('b',123); AssertEquals('List is dirty',True,FP.Dirty); FP.BuildHashList; FP.Identifiers.Delete(0); AssertEquals('List is dirty',True,FP.Dirty); end; procedure TTestParserVariables.TestVariable9; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',123); FP.Expression:='a'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); AssertResultType(rtInteger); AssertResult(123); end; procedure TTestParserVariables.TestVariable10; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddStringVariable('a','a123'); FP.Expression:='a'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); AssertResultType(rtString); AssertResult('a123'); end; procedure TTestParserVariables.TestVariable11; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFloatVariable('a',1.23); FP.Expression:='a'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); AssertResultType(rtFloat); AssertResult(1.23); end; procedure TTestParserVariables.TestVariable12; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddBooleanVariable('a',True); FP.Expression:='a'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserVariables.TestVariable13; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddDateTimeVariable('a',D); FP.Expression:='a'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode); AssertResultType(rtDateTime); AssertDateTimeResult(D); end; procedure TTestParserVariables.TestVariable14; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); FP.BuildHashList; S:=FP.IdentifierByName('a'); AssertSame('Identifier found',I,S); end; procedure TTestParserVariables.TestVariable15; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); FP.BuildHashList; S:=FP.IdentifierByName('A'); AssertSame('Identifier found',I,S); end; procedure TTestParserVariables.TestVariable16; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); FP.BuildHashList; S:=FP.IdentifierByName('B'); AssertNull('Identifier not found',S); end; procedure TTestParserVariables.TestVariable17; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); FP.BuildHashList; AssertException('Identifier not found',EExprParser,@unknownvariable); end; procedure TTestParserVariables.TestVariable18; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); S:=FP.Identifiers.FindIdentifier('B'); AssertNull('Identifier not found',S); end; procedure TTestParserVariables.TestVariable19; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); S:=FP.Identifiers.FindIdentifier('a'); AssertSame('Identifier found',I,S); end; procedure TTestParserVariables.TestVariable20; Var I,S : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddIntegerVariable('a',1); S:=FP.Identifiers.FindIdentifier('A'); AssertSame('Identifier found',I,S); end; procedure TTestParserVariables.TestAccess(Skip : TResultType); Var rt : TResultType; begin For rt:=Low(TResultType) to High(TResultType) do if rt<>skip then begin FasWrongType:=rt; AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype); end; For rt:=Low(TResultType) to High(TResultType) do if rt<>skip then begin FasWrongType:=rt; AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype); end; end; procedure TTestParserVariables.TestVariable21; begin FP.IDentifiers.AddIntegerVariable('a',1); TestAccess(rtInteger); end; procedure TTestParserVariables.TestVariable22; begin FP.IDentifiers.AddFloatVariable('a',1.0); TestAccess(rtFloat); end; procedure TTestParserVariables.TestVariable23; begin FP.IDentifiers.AddStringVariable('a','1.0'); TestAccess(rtString); end; procedure TTestParserVariables.TestVariable24; begin FP.IDentifiers.AddBooleanVariable('a',True); TestAccess(rtBoolean); end; procedure TTestParserVariables.TestVariable25; begin FP.IDentifiers.AddDateTimeVariable('a',Date); TestAccess(rtDateTime); end; procedure TTestParserVariables.TestVariable26; Var I : TFPExprIdentifierDef; begin I:=FP.IDentifiers.AddStringVariable('a','1.0'); I.AsString:='12'; AssertEquals('Correct value','12',I.AsString); end; procedure TTestParserVariables.TestVariable27; Var I : TFPExprIdentifierDef; begin I:=FP.IDentifiers.AddIntegerVariable('a',10); I.Asinteger:=12; AssertEquals('Correct value',12,I.AsInteger); end; procedure TTestParserVariables.TestVariable28; Var I : TFPExprIdentifierDef; begin I:=FP.IDentifiers.AddFloatVariable('a',1.0); I.AsFloat:=1.2; AssertEquals('Correct value',1.2,I.AsFloat); end; procedure TTestParserVariables.TestVariable29; Var I : TFPExprIdentifierDef; begin I:=FP.IDentifiers.AddDateTimeVariable('a',Now); I.AsDateTime:=Date-1; AssertEquals('Correct value',Date-1,I.AsDateTime); end; procedure TTestParserVariables.TestVariable30; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddBooleanVariable('a',True); I.AsBoolean:=False; AssertEquals('Correct value',False,I.AsBoolean); end; Procedure EchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resDateTime:=Args[0].resDateTime; end; Procedure EchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resInteger:=Args[0].resInteger; end; Procedure EchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resBoolean:=Args[0].resBoolean; end; Procedure EchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resFloat:=Args[0].resFloat; end; Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resString:=Args[0].resString; end; Procedure TTestExpressionParser.DoEchoDate(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resDateTime:=Args[0].resDateTime; end; Procedure TTestExpressionParser.DoEchoInteger(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resInteger:=Args[0].resInteger; end; Procedure TTestExpressionParser.DoEchoBoolean(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resBoolean:=Args[0].resBoolean; end; Procedure TTestExpressionParser.DoEchoFloat(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resFloat:=Args[0].resFloat; end; Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray); begin Result.resString:=Args[0].resString; end; procedure TTestExpressionParser.DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray); begin Result.ResDatetime:=Date; end; procedure TTestExpressionParser.DoAddInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray); begin Result.Resinteger:=Args[0].ResInteger+Args[1].ResInteger; end; procedure TTestExpressionParser.DoDeleteString(var Result: TFPExpressionResult; Const Args: TExprParameterArray); begin Result.ResString:=Args[0].ResString; Delete(Result.ResString,Args[1].ResInteger,Args[2].ResInteger); end; procedure TTestParserFunctions.TryRead; Var Res : TFPExpressioNResult; begin AssertEquals('Only one identifier',1,FP.Identifiers.Count); Case FAccessAs of rtBoolean : res.ResBoolean:=FP.Identifiers[0].AsBoolean; rtString : res.ResString:=FP.Identifiers[0].AsString; rtInteger : Res.ResInteger:=FP.Identifiers[0].AsInteger; rtFloat : Res.ResFloat:=FP.Identifiers[0].AsFloat; rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime; end; end; procedure TTestParserFunctions.TryWrite; Var Res : TFPExpressioNResult; begin AssertEquals('Only one identifier',1,FP.Identifiers.Count); Case FAccessAs of rtBoolean : FP.Identifiers[0].AsBoolean:=res.ResBoolean; rtString : FP.Identifiers[0].AsString:=res.ResString; rtInteger : FP.Identifiers[0].AsInteger:=Res.ResInteger; rtFloat : FP.Identifiers[0].AsFloat:=Res.ResFloat; rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime; end; end; // TTestParserFunctions procedure TTestParserFunctions.TestFunction1; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('Date','D','',@GetDate); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack)); FaccessAs:=rtDateTime; AssertException('No read access',EExprParser,@TryRead); AssertException('No write access',EExprParser,@TryWrite); end; procedure TTestParserFunctions.TestFunction2; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); AssertSame('Function has correct address',Pointer(@EchoDate),Pointer(I.OnGetFunctionValueCallBack)); end; procedure TTestParserFunctions.TestFunction3; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack)); FaccessAs:=rtInteger; AssertException('No read access',EExprParser,@TryRead); AssertException('No write access',EExprParser,@TryWrite); end; procedure TTestParserFunctions.TestFunction4; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType); AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack)); FaccessAs:=rtBoolean; AssertException('No read access',EExprParser,@TryRead); AssertException('No write access',EExprParser,@TryWrite); end; procedure TTestParserFunctions.TestFunction5; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtFloat,I.ResultType); AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack)); FaccessAs:=rtfloat; AssertException('No read access',EExprParser,@TryRead); AssertException('No write access',EExprParser,@TryWrite); end; procedure TTestParserFunctions.TestFunction6; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtString,I.ResultType); AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack)); FaccessAs:=rtString; AssertException('No read access',EExprParser,@TryRead); AssertException('No write access',EExprParser,@TryWrite); end; procedure TTestParserFunctions.TestFunction7; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); // AssertSame('Function has correct address',TMethod(@Self.DoEchoDate),TMethod(I.OnGetFunctionValue)); end; procedure TTestParserFunctions.TestFunction8; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DOEchoInteger); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); // AssertSame('Function has correct address',Pointer(@EchoInteger),Pointer(I.OnGetFunctionValueCallBack)); end; procedure TTestParserFunctions.TestFunction9; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtBoolean,I.ResultType); // AssertSame('Function has correct address',Pointer(@EchoBoolean),Pointer(I.OnGetFunctionValueCallBack)); end; procedure TTestParserFunctions.TestFunction10; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtFloat,I.ResultType); // AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack)); end; procedure TTestParserFunctions.TestFunction11; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtString,I.ResultType); // AssertSame('Function has correct address',Pointer(@EchoString),Pointer(I.OnGetFunctionValueCallBack)); end; procedure TTestParserFunctions.TestFunction12; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('Date','D','',@GetDate); FP.Expression:='Date'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); AssertResultType(rtDateTime); AssertDateTimeResult(D); end; procedure TTestParserFunctions.TestFunction13; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddDateTimeVariable('a',D); I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate); FP.Expression:='EchoDate(a)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); AssertResultType(rtDateTime); AssertDateTimeResult(D); end; procedure TTestParserFunctions.TestFunction14; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger); FP.Expression:='EchoInteger(13)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); AssertResultType(rtInteger); AssertResult(13); end; procedure TTestParserFunctions.TestFunction15; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean); FP.Expression:='EchoBoolean(True)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserFunctions.TestFunction16; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat); FP.Expression:='EchoFloat(1.234)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); AssertResultType(rtFloat); AssertResult(1.234); end; procedure TTestParserFunctions.TestFunction17; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString); FP.Expression:='EchoString(''Aloha'')'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode); AssertResultType(rtString); AssertResult('Aloha'); end; procedure TTestParserFunctions.TestFunction18; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddDateTimeVariable('a',D); I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate); FP.Expression:='EchoDate(a)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtDateTime); AssertDateTimeResult(D); end; procedure TTestParserFunctions.TestFunction19; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger); FP.Expression:='EchoInteger(13)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtInteger); AssertResult(13); end; procedure TTestParserFunctions.TestFunction20; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean); FP.Expression:='EchoBoolean(True)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtBoolean); AssertResult(True); end; procedure TTestParserFunctions.TestFunction21; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat); FP.Expression:='EchoFloat(1.234)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtFloat); AssertResult(1.234); end; procedure TTestParserFunctions.TestFunction22; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString); FP.Expression:='EchoString(''Aloha'')'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtString); AssertResult('Aloha'); end; procedure TTestParserFunctions.TestFunction23; Var I : TFPExprIdentifierDef; D : TDateTime; begin D:=Date; I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); FP.Expression:='Date'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtDateTime); AssertDateTimeResult(D); end; procedure TTestParserFunctions.TestFunction24; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); FP.Expression:='AddInteger(1,2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtInteger); AssertResult(3); end; procedure TTestParserFunctions.TestFunction25; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtString,I.ResultType); FP.Expression:='Delete(''ABCDEFGHIJ'',3,2)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtString); AssertResult('ABEFGHIJ'); end; procedure TTestParserFunctions.TestFunction26; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); FP.Expression:='AddInteger(1,2+3)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtInteger); AssertResult(6); end; procedure TTestParserFunctions.TestFunction27; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); FP.Expression:='AddInteger(1+2,3*4)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtInteger); AssertResult(15); end; procedure TTestParserFunctions.TestFunction28; Var I : TFPExprIdentifierDef; begin I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); AssertEquals('List is dirty',True,FP.Dirty); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FP.Identifiers.Count); AssertSame('Result equals variable added',I,FP.Identifiers[0]); AssertEquals('Function has correct resulttype',rtInteger,I.ResultType); FP.Expression:='AddInteger(3 and 2,3*4)'; AssertNotNull('Have result node',FP.ExprNode); AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode); AssertResultType(rtInteger); AssertResult(14); end; procedure TTestParserFunctions.TestFunction29; Var I : TFPExprIdentifierDef; begin // Test type mismatch I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger); TestParser('AddInteger(3 and 2,''s'')'); end; { TTestBuiltinsManager } procedure TTestBuiltinsManager.Setup; begin inherited Setup; FM:=TExprBuiltInManager.Create(Nil); end; procedure TTestBuiltinsManager.Teardown; begin FreeAndNil(FM); inherited Teardown; end; procedure TTestBuiltinsManager.TestCreate; begin AssertEquals('Have no builtin expressions',0,FM.IdentifierCount); end; procedure TTestBuiltinsManager.TestVariable1; Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.AddVariable(bcuser,'a',rtBoolean,'True'); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); AssertEquals('Variable has correct value','True',I.Value); end; procedure TTestBuiltinsManager.TestVariable2; Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.AddBooleanVariable(bcUser,'a',False); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Variable has correct resulttype',rtBoolean,I.ResultType); AssertEquals('Variable has correct value','False',I.Value); end; procedure TTestBuiltinsManager.TestVariable3; Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.AddIntegerVariable(bcUser,'a',123); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Variable has correct resulttype',rtInteger,I.ResultType); AssertEquals('Variable has correct value','123',I.Value); end; procedure TTestBuiltinsManager.TestVariable4; Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.AddFloatVariable(bcUser,'a',1.23); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Variable has correct resulttype',rtFloat,I.ResultType); AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value); end; procedure TTestBuiltinsManager.TestVariable5; Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.AddStringVariable(bcUser,'a','1.23'); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Variable has correct resulttype',rtString,I.ResultType); AssertEquals('Variable has correct value','1.23',I.Value); end; procedure TTestBuiltinsManager.TestVariable6; Var I : TFPBuiltinExprIdentifierDef; D : TDateTime; begin D:=Now; I:=FM.AddDateTimeVariable(bcUser,'a',D); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Variable has correct resulttype',rtDateTime,I.ResultType); AssertEquals('Variable has correct value',FormatDateTime('cccc',D),I.Value); end; procedure TTestBuiltinsManager.TestFunction1; Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.AddFunction(bcUser,'Date','D','',@GetDate); AssertNotNull('Addvariable returns result',I); AssertEquals('One variable added',1,FM.IdentifierCount); AssertSame('Result equals variable added',I,FM.Identifiers[0]); AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category)); AssertEquals('Function has correct resulttype',rtDateTime,I.ResultType); AssertSame('Function has correct address',Pointer(@GetDate),Pointer(I.OnGetFunctionValueCallBack)); end; procedure TTestBuiltinsManager.TestFunction2; Var I,I2 : TFPBuiltinExprIdentifierDef; ind : Integer; begin FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate); I:=FM.AddFunction(bcUser,'Echo','D','D',@EchoDate); FM.AddFunction(bcUser,'DoEcho','D','D',@EchoDate); ind:=FM.IndexOfIdentifier('Echo'); AssertEquals('Found identifier',1,ind); I2:=FM.FindIdentifier('Echo'); AssertNotNull('FindIdentifier returns result',I2); AssertSame('Findidentifier returns correct result',I,I2); ind:=FM.IndexOfIdentifier('NoNoNo'); AssertEquals('Found no such identifier',-1,ind); I2:=FM.FindIdentifier('NoNoNo'); AssertNull('FindIdentifier returns no result',I2); end; { TTestBuiltins } procedure TTestBuiltins.Setup; begin inherited Setup; FM:=TExprBuiltInManager.Create(Nil); end; procedure TTestBuiltins.Teardown; begin FreeAndNil(FM); inherited Teardown; end; procedure TTestBuiltins.SetExpression(Const AExpression : String); Var Msg : String; begin Msg:=''; try FP.Expression:=AExpression; except On E : Exception do Msg:=E.message; end; If (Msg<>'') then Fail('Parsing of expression "'+AExpression+'" failed :'+Msg); end; procedure TTestBuiltins.AssertVariable(const ADefinition: String; AResultType: TResultType); Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.FindIdentifier(ADefinition); AssertNotNull('Definition '+ADefinition+' is present.',I); AssertEquals('Correct result type',AResultType,I.ResultType); end; procedure TTestBuiltins.AssertFunction(const ADefinition, AResultType, ArgumentTypes: String; ACategory : TBuiltinCategory); Var I : TFPBuiltinExprIdentifierDef; begin I:=FM.FindIdentifier(ADefinition); AssertEquals('Correct result type for test',1,Length(AResultType)); AssertNotNull('Definition '+ADefinition+' is present.',I); AssertEquals(ADefinition+' has correct parameter types',ArgumentTypes,I.ParameterTypes); AssertEquals(ADefinition+' has correct result type',CharToResultType(AResultType[1]),I.ResultType); AssertEquals(ADefinition+' has correct category',Ord(ACategory),Ord(I.Category)); end; procedure TTestBuiltins.AssertExpression(const AExpression: String; AResult: Int64); begin FP.BuiltIns:=AllBuiltIns; SetExpression(AExpression); AssertResult(AResult); end; procedure TTestBuiltins.AssertExpression(const AExpression: String; const AResult: String); begin FP.BuiltIns:=AllBuiltIns; SetExpression(AExpression); AssertResult(AResult); end; procedure TTestBuiltins.AssertExpression(const AExpression: String; const AResult: TExprFloat); begin FP.BuiltIns:=AllBuiltIns; SetExpression(AExpression); AssertResult(AResult); end; procedure TTestBuiltins.AssertExpression(const AExpression: String; const AResult: Boolean); begin FP.BuiltIns:=AllBuiltIns; SetExpression(AExpression); AssertResult(AResult); end; procedure TTestBuiltins.AssertDateTimeExpression(const AExpression: String; const AResult: TDateTime); begin FP.BuiltIns:=AllBuiltIns; SetExpression(AExpression); AssertDatetimeResult(AResult); end; procedure TTestBuiltins.TestRegister; begin RegisterStdBuiltins(FM); AssertEquals('Correct number of identifiers',64,FM.IdentifierCount); Assertvariable('pi',rtFloat); AssertFunction('cos','F','F',bcMath); AssertFunction('sin','F','F',bcMath); AssertFunction('arctan','F','F',bcMath); AssertFunction('abs','F','F',bcMath); AssertFunction('sqr','F','F',bcMath); AssertFunction('sqrt','F','F',bcMath); AssertFunction('exp','F','F',bcMath); AssertFunction('ln','F','F',bcMath); AssertFunction('log','F','F',bcMath); AssertFunction('frac','F','F',bcMath); AssertFunction('int','F','F',bcMath); AssertFunction('round','I','F',bcMath); AssertFunction('trunc','I','F',bcMath); AssertFunction('length','I','S',bcStrings); AssertFunction('copy','S','SII',bcStrings); AssertFunction('delete','S','SII',bcStrings); AssertFunction('pos','I','SS',bcStrings); AssertFunction('lowercase','S','S',bcStrings); AssertFunction('uppercase','S','S',bcStrings); AssertFunction('stringreplace','S','SSSBB',bcStrings); AssertFunction('comparetext','I','SS',bcStrings); AssertFunction('date','D','',bcDateTime); AssertFunction('time','D','',bcDateTime); AssertFunction('now','D','',bcDateTime); AssertFunction('dayofweek','I','D',bcDateTime); AssertFunction('extractyear','I','D',bcDateTime); AssertFunction('extractmonth','I','D',bcDateTime); AssertFunction('extractday','I','D',bcDateTime); AssertFunction('extracthour','I','D',bcDateTime); AssertFunction('extractmin','I','D',bcDateTime); AssertFunction('extractsec','I','D',bcDateTime); AssertFunction('extractmsec','I','D',bcDateTime); AssertFunction('encodedate','D','III',bcDateTime); AssertFunction('encodetime','D','IIII',bcDateTime); AssertFunction('encodedatetime','D','IIIIIII',bcDateTime); AssertFunction('shortdayname','S','I',bcDateTime); AssertFunction('shortmonthname','S','I',bcDateTime); AssertFunction('longdayname','S','I',bcDateTime); AssertFunction('longmonthname','S','I',bcDateTime); AssertFunction('formatdatetime','S','SD',bcDateTime); AssertFunction('shl','I','II',bcBoolean); AssertFunction('shr','I','II',bcBoolean); AssertFunction('IFS','S','BSS',bcBoolean); AssertFunction('IFF','F','BFF',bcBoolean); AssertFunction('IFD','D','BDD',bcBoolean); AssertFunction('IFI','I','BII',bcBoolean); AssertFunction('inttostr','S','I',bcConversion); AssertFunction('strtoint','I','S',bcConversion); AssertFunction('strtointdef','I','SI',bcConversion); AssertFunction('floattostr','S','F',bcConversion); AssertFunction('strtofloat','F','S',bcConversion); AssertFunction('strtofloatdef','F','SF',bcConversion); AssertFunction('booltostr','S','B',bcConversion); AssertFunction('strtobool','B','S',bcConversion); AssertFunction('strtobooldef','B','SB',bcConversion); AssertFunction('datetostr','S','D',bcConversion); AssertFunction('timetostr','S','D',bcConversion); AssertFunction('strtodate','D','S',bcConversion); AssertFunction('strtodatedef','D','SD',bcConversion); AssertFunction('strtotime','D','S',bcConversion); AssertFunction('strtotimedef','D','SD',bcConversion); AssertFunction('strtodatetime','D','S',bcConversion); AssertFunction('strtodatetimedef','D','SD',bcConversion); end; procedure TTestBuiltins.TestVariablepi; begin AssertExpression('pi',Pi); end; procedure TTestBuiltins.TestFunctioncos; begin AssertExpression('cos(0.5)',Cos(0.5)); AssertExpression('cos(0.75)',Cos(0.75)); end; procedure TTestBuiltins.TestFunctionsin; begin AssertExpression('sin(0.5)',sin(0.5)); AssertExpression('sin(0.75)',sin(0.75)); end; procedure TTestBuiltins.TestFunctionarctan; begin AssertExpression('arctan(0.5)',arctan(0.5)); AssertExpression('arctan(0.75)',arctan(0.75)); end; procedure TTestBuiltins.TestFunctionabs; begin AssertExpression('abs(0.5)',0.5); AssertExpression('abs(-0.75)',0.75); end; procedure TTestBuiltins.TestFunctionsqr; begin AssertExpression('sqr(0.5)',sqr(0.5)); AssertExpression('sqr(-0.75)',sqr(0.75)); end; procedure TTestBuiltins.TestFunctionsqrt; begin AssertExpression('sqrt(0.5)',sqrt(0.5)); AssertExpression('sqrt(0.75)',sqrt(0.75)); end; procedure TTestBuiltins.TestFunctionexp; begin AssertExpression('exp(1.0)',exp(1)); AssertExpression('exp(0.0)',1.0); end; procedure TTestBuiltins.TestFunctionln; begin AssertExpression('ln(0.5)',ln(0.5)); AssertExpression('ln(1.5)',ln(1.5)); end; procedure TTestBuiltins.TestFunctionlog; begin AssertExpression('log(0.5)',ln(0.5)/ln(10.0)); AssertExpression('log(1.5)',ln(1.5)/ln(10.0)); AssertExpression('log(10.0)',1.0); end; procedure TTestBuiltins.TestFunctionfrac; begin AssertExpression('frac(0.5)',frac(0.5)); AssertExpression('frac(1.5)',frac(1.5)); end; procedure TTestBuiltins.TestFunctionint; begin AssertExpression('int(0.5)',int(0.5)); AssertExpression('int(1.5)',int(1.5)); end; procedure TTestBuiltins.TestFunctionround; begin AssertExpression('round(0.5)',round(0.5)); AssertExpression('round(1.55)',round(1.55)); end; procedure TTestBuiltins.TestFunctiontrunc; begin AssertExpression('trunc(0.5)',trunc(0.5)); AssertExpression('trunc(1.55)',trunc(1.55)); end; procedure TTestBuiltins.TestFunctionlength; begin AssertExpression('length(''123'')',3); end; procedure TTestBuiltins.TestFunctioncopy; begin AssertExpression('copy(''123456'',2,4)','2345'); end; procedure TTestBuiltins.TestFunctiondelete; begin AssertExpression('delete(''123456'',2,4)','16'); end; procedure TTestBuiltins.TestFunctionpos; begin AssertExpression('pos(''234'',''123456'')',2); end; procedure TTestBuiltins.TestFunctionlowercase; begin AssertExpression('lowercase(''AbCdEf'')','abcdef'); end; procedure TTestBuiltins.TestFunctionuppercase; begin AssertExpression('uppercase(''AbCdEf'')','ABCDEF'); end; procedure TTestBuiltins.TestFunctionstringreplace; begin // last options are replaceall, ignorecase AssertExpression('stringreplace(''AbCdEf'',''C'',''Z'',false,false)','AbZdEf'); AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,false)','AbCdEf'); AssertExpression('stringreplace(''AbCdEf'',''c'',''Z'',false,true)','AbZdEf'); AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',false,false)','AbZdEfC'); AssertExpression('stringreplace(''AbCdEfC'',''C'',''Z'',True,false)','AbZdEfZ'); end; procedure TTestBuiltins.TestFunctioncomparetext; begin AssertExpression('comparetext(''AbCdEf'',''AbCdEf'')',0); AssertExpression('comparetext(''AbCdEf'',''ABCDEF'')',0); AssertExpression('comparetext(''AbCdEf'',''FEDCBA'')',comparetext('AbCdEf','FEDCBA')); end; procedure TTestBuiltins.TestFunctiondate; begin AssertExpression('date',date); end; procedure TTestBuiltins.TestFunctiontime; begin AssertExpression('time',time); end; procedure TTestBuiltins.TestFunctionnow; begin AssertExpression('now',now); end; procedure TTestBuiltins.TestFunctiondayofweek; begin FP.Identifiers.AddDateTimeVariable('D',Date); AssertExpression('dayofweek(d)',DayOfWeek(date)); end; procedure TTestBuiltins.TestFunctionextractyear; Var Y,M,D : Word; begin DecodeDate(Date,Y,M,D); FP.Identifiers.AddDateTimeVariable('D',Date); AssertExpression('extractyear(d)',Y); end; procedure TTestBuiltins.TestFunctionextractmonth; Var Y,M,D : Word; begin FP.Identifiers.AddDateTimeVariable('D',Date); DecodeDate(Date,Y,M,D); AssertExpression('extractmonth(d)',M); end; procedure TTestBuiltins.TestFunctionextractday; Var Y,M,D : Word; begin DecodeDate(Date,Y,M,D); FP.Identifiers.AddDateTimeVariable('D',Date); AssertExpression('extractday(d)',D); end; procedure TTestBuiltins.TestFunctionextracthour; Var T : TDateTime; H,m,s,ms : Word; begin T:=Time; DecodeTime(T,h,m,s,ms); FP.Identifiers.AddDateTimeVariable('T',T); AssertExpression('extracthour(t)',h); end; procedure TTestBuiltins.TestFunctionextractmin; Var T : TDateTime; H,m,s,ms : Word; begin T:=Time; DecodeTime(T,h,m,s,ms); FP.Identifiers.AddDateTimeVariable('T',T); AssertExpression('extractmin(t)',m); end; procedure TTestBuiltins.TestFunctionextractsec; Var T : TDateTime; H,m,s,ms : Word; begin T:=Time; DecodeTime(T,h,m,s,ms); FP.Identifiers.AddDateTimeVariable('T',T); AssertExpression('extractsec(t)',s); end; procedure TTestBuiltins.TestFunctionextractmsec; Var T : TDateTime; H,m,s,ms : Word; begin T:=Time; DecodeTime(T,h,m,s,ms); FP.Identifiers.AddDateTimeVariable('T',T); AssertExpression('extractmsec(t)',ms); end; procedure TTestBuiltins.TestFunctionencodedate; begin AssertExpression('encodedate(2008,10,11)',EncodeDate(2008,10,11)); end; procedure TTestBuiltins.TestFunctionencodetime; begin AssertExpression('encodetime(14,10,11,0)',EncodeTime(14,10,11,0)); end; procedure TTestBuiltins.TestFunctionencodedatetime; begin AssertExpression('encodedatetime(2008,12,13,14,10,11,0)',EncodeDate(2008,12,13)+EncodeTime(14,10,11,0)); end; procedure TTestBuiltins.TestFunctionshortdayname; begin AssertExpression('shortdayname(1)',ShortDayNames[1]); AssertExpression('shortdayname(7)',ShortDayNames[7]); end; procedure TTestBuiltins.TestFunctionshortmonthname; begin AssertExpression('shortmonthname(1)',ShortMonthNames[1]); AssertExpression('shortmonthname(12)',ShortMonthNames[12]); end; procedure TTestBuiltins.TestFunctionlongdayname; begin AssertExpression('longdayname(1)',longDayNames[1]); AssertExpression('longdayname(7)',longDayNames[7]); end; procedure TTestBuiltins.TestFunctionlongmonthname; begin AssertExpression('longmonthname(1)',longMonthNames[1]); AssertExpression('longmonthname(12)',longMonthNames[12]); end; procedure TTestBuiltins.TestFunctionformatdatetime; begin AssertExpression('FormatDateTime(''cccc'',Date)',FormatDateTime('cccc',Date)); end; procedure TTestBuiltins.TestFunctionshl; Var I : Int64; begin AssertExpression('shl(12,3)',12 shl 3); I:=12 shl 30; AssertExpression('shl(12,30)',I); end; procedure TTestBuiltins.TestFunctionshr; begin AssertExpression('shr(12,2)',12 shr 2); end; procedure TTestBuiltins.TestFunctionIFS; begin AssertExpression('ifs(true,''string1'',''string2'')','string1'); AssertExpression('ifs(false,''string1'',''string2'')','string2'); end; procedure TTestBuiltins.TestFunctionIFF; begin AssertExpression('iff(true,1.0,2.0)',1.0); AssertExpression('iff(false,1.0,2.0)',2.0); end; procedure TTestBuiltins.TestFunctionIFD; begin FP.Identifiers.AddDateTimeVariable('A',Date); FP.Identifiers.AddDateTimeVariable('B',Date-1); AssertExpression('ifd(true,A,B)',Date); AssertExpression('ifd(false,A,B)',Date-1); end; procedure TTestBuiltins.TestFunctionIFI; begin AssertExpression('ifi(true,1,2)',1); AssertExpression('ifi(false,1,2)',2); end; procedure TTestBuiltins.TestFunctioninttostr; begin AssertExpression('inttostr(2)','2'); end; procedure TTestBuiltins.TestFunctionstrtoint; begin AssertExpression('strtoint(''2'')',2); end; procedure TTestBuiltins.TestFunctionstrtointdef; begin AssertExpression('strtointdef(''abc'',2)',2); end; procedure TTestBuiltins.TestFunctionfloattostr; begin AssertExpression('floattostr(1.23)',Floattostr(1.23)); end; procedure TTestBuiltins.TestFunctionstrtofloat; Var S : String; begin S:='1.23'; S[2]:=DecimalSeparator; AssertExpression('strtofloat('''+S+''')',1.23); end; procedure TTestBuiltins.TestFunctionstrtofloatdef; begin AssertExpression('strtofloatdef(''abc'',1.23)',1.23); end; procedure TTestBuiltins.TestFunctionbooltostr; begin AssertExpression('strtofloatdef(''abc'',1.23)',1.23); end; procedure TTestBuiltins.TestFunctionstrtobool; begin AssertExpression('strtobool(''0'')',false); end; procedure TTestBuiltins.TestFunctionstrtobooldef; begin AssertExpression('strtobooldef(''XYZ'',True)',True); end; procedure TTestBuiltins.TestFunctiondatetostr; begin FP.Identifiers.AddDateTimeVariable('A',Date); AssertExpression('DateToStr(A)',DateToStr(Date)); end; procedure TTestBuiltins.TestFunctiontimetostr; Var T : TDateTime; begin T:=Time; FP.Identifiers.AddDateTimeVariable('A',T); AssertExpression('TimeToStr(A)',TimeToStr(T)); end; procedure TTestBuiltins.TestFunctionstrtodate; begin FP.Identifiers.AddStringVariable('S',DateToStr(Date)); AssertExpression('StrToDate(S)',Date); end; procedure TTestBuiltins.TestFunctionstrtodatedef; begin FP.Identifiers.AddDateTimeVariable('A',Date); AssertExpression('StrToDateDef(''S'',A)',Date); end; procedure TTestBuiltins.TestFunctionstrtotime; Var T : TDateTime; begin T:=Time; FP.Identifiers.AddStringVariable('S',TimeToStr(T)); AssertExpression('StrToTime(S)',T); end; procedure TTestBuiltins.TestFunctionstrtotimedef; Var T : TDateTime; begin T:=Time; FP.Identifiers.AddDateTimeVariable('S',T); AssertExpression('StrToTimeDef(''q'',S)',T); end; procedure TTestBuiltins.TestFunctionstrtodatetime; Var T : TDateTime; S : String; begin T:=Now; S:=DateTimetostr(T); AssertExpression('StrToDateTime('''+S+''')',T); end; procedure TTestBuiltins.TestFunctionstrtodatetimedef; Var T : TDateTime; S : String; begin T:=Now; S:=DateTimetostr(T); FP.Identifiers.AddDateTimeVariable('S',T); AssertExpression('StrToDateTimeDef('''+S+''',S)',T); end; { TTestNotNode } procedure TTestNotNode.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestNotNode.TestCreateInteger; begin FN:=TFPNotNode.Create(CreateIntNode(3)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',Not(Int64(3)),FN.NodeValue.ResInteger); end; procedure TTestNotNode.TestCreateBoolean; begin FN:=TFPNotNode.Create(CreateBoolNode(True)); AssertNodeOK(FN); AssertEquals('Correct node type',rtBoolean,FN.NodeType); AssertEquals('Correct result',False,FN.NodeValue.ResBoolean); end; procedure TTestNotNode.TestCreateString; begin FN:=TFPNotNode.Create(CreateStringNode('True')); AssertNodeNotOK('String node type',FN); end; procedure TTestNotNode.TestCreateFloat; begin FN:=TFPNotNode.Create(CreateFloatNode(1.23)); AssertNodeNotOK('String node type',FN); end; procedure TTestNotNode.TestCreateDateTime; begin FN:=TFPNotNode.Create(CreateDateTimeNode(Now)); AssertNodeNotOK('String node type',FN); end; procedure TTestNotNode.TestDestroy; begin FN:=TFPNotNode.Create(TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for operand',1,self.FDestroyCalled) end; { TTestIfOperation } procedure TTestIfOperation.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestIfOperation.TestCreateInteger; begin FN:=TIfOperation.Create(CreateIntNode(1),CreateIntNode(2),CreateIntNode(3)); AssertNodeNotOK('First argument wrong',FN); end; procedure TTestIfOperation.TestCreateBoolean; begin FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',2,FN.NodeValue.ResInteger); end; procedure TTestIfOperation.TestCreateBoolean2; begin FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateIntNode(3)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',3,FN.NodeValue.ResInteger); end; procedure TTestIfOperation.TestCreateBooleanInteger; begin FN:=TIfOperation.Create(CreateBoolNode(False),CreateIntNode(2),CreateBoolNode(False)); AssertNodeNotOK('Arguments differ in type',FN); end; procedure TTestIfOperation.TestCreateBooleanInteger2; begin FN:=TIfOperation.Create(CreateBoolNode(True),CreateIntNode(2),CreateIntNode(3)); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',2,FN.NodeValue.ResInteger); end; procedure TTestIfOperation.TestCreateBooleanString; begin FN:=TIfOperation.Create(CreateBoolNode(True),CreateStringNode('2'),CreateStringNode('3')); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','2',FN.NodeValue.ResString); end; procedure TTestIfOperation.TestCreateBooleanString2; begin FN:=TIfOperation.Create(CreateBoolNode(False),CreateStringNode('2'),CreateStringNode('3')); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','3',FN.NodeValue.ResString); end; procedure TTestIfOperation.TestCreateBooleanDateTime; begin FN:=TIfOperation.Create(CreateBoolNode(True),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1)); AssertNodeOK(FN); AssertEquals('Correct node type',rtDateTime,FN.NodeType); AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime); end; procedure TTestIfOperation.TestCreateBooleanDateTime2; begin FN:=TIfOperation.Create(CreateBoolNode(False),CreateDateTimeNode(Date),CreateDateTimeNode(Date-1)); AssertNodeOK(FN); AssertEquals('Correct node type',rtDateTime,FN.NodeType); AssertEquals('Correct result',Date-1,FN.NodeValue.ResDateTime); end; procedure TTestIfOperation.TestCreateString; begin FN:=TIfOperation.Create(CreateStringNode('1'),CreateIntNode(2),CreateIntNode(3)); AssertNodeNotOK('First argument wrong',FN); end; procedure TTestIfOperation.TestCreateFloat; begin FN:=TIfOperation.Create(CreateFloatNode(2.0),CreateIntNode(2),CreateIntNode(3)); AssertNodeNotOK('First argument wrong',FN); end; procedure TTestIfOperation.TestCreateDateTime; begin FN:=TIfOperation.Create(CreateDateTimeNode(Date),CreateIntNode(2),CreateIntNode(3)); AssertNodeNotOK('First argument wrong',FN); end; procedure TTestIfOperation.TestDestroy; begin FN:=TIfOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self)); FreeAndNil(FN); AssertEquals('Destroy called for operand',3,self.FDestroyCalled) end; { TTestCaseOperation } function TTestCaseOperation.CreateArgs( Args: array of const): TExprArgumentArray; Var I : Integer; begin SetLength(Result,High(Args)-Low(Args)+1); For I:=Low(Args) to High(Args) do Result[I]:=Args[i].VObject as TFPExprNode; end; procedure TTestCaseOperation.TearDown; begin FreeAndNil(FN); inherited TearDown; end; procedure TTestCaseOperation.TestCreateOne; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False)])); AssertNodeNotOK('Too little arguments',FN); end; procedure TTestCaseOperation.TestCreateTwo; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False)])); AssertNodeNotOK('Too little arguments',FN); end; procedure TTestCaseOperation.TestCreateThree; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False),CreateBoolNode(False)])); AssertNodeNotOK('Too little arguments',FN); end; procedure TTestCaseOperation.TestCreateOdd; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False),CreateBoolNode(False), CreateBoolNode(False),CreateBoolNode(False), CreateBoolNode(False)])); AssertNodeNotOK('Odd number of arguments',FN); end; procedure TTestCaseOperation.TestCreateNoExpression; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(False), CreateBoolNode(False), TFPBinaryOrOperation.Create(CreateBoolNode(False),CreateBoolNode(False)), CreateBoolNode(False)])); AssertNodeNotOK('Label is not a constant expression',FN); end; procedure TTestCaseOperation.TestCreateWrongLabel; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False), CreateIntNode(1),CreateBoolNode(False), CreateBoolNode(True),CreateBoolNode(False)])); AssertNodeNotOK('Wrong label',FN); end; procedure TTestCaseOperation.TestCreateWrongValue; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False), CreateIntNode(1),CreateBoolNode(False), CreateIntNode(2),CreateIntNode(1)])); AssertNodeNotOK('Wrong value',FN); end; procedure TTestCaseOperation.TestIntegerTag; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'), CreateIntNode(1),CreateStringNode('one'), CreateIntNode(2),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','one',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestIntegerTagDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'), CreateIntNode(1),CreateStringNode('one'), CreateIntNode(2),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','many',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestStringTag; begin FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('one'),CreateIntNode(3), CreateStringNode('one'),CreateIntNode(1), CreateStringNode('two'),CreateIntNode(2)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',1,FN.NodeValue.ResInteger); end; procedure TTestCaseOperation.TestStringTagDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateStringNode('many'),CreateIntNode(3), CreateStringNode('one'),CreateIntNode(1), CreateStringNode('two'),CreateIntNode(2)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',3,FN.NodeValue.ResInteger); end; procedure TTestCaseOperation.TestFloatTag; begin FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(1.0),CreateStringNode('many'), CreateFloatNode(1.0),CreateStringNode('one'), CreateFloatNode(2.0),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','one',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestFloatTagDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateFloatNode(3.0),CreateStringNode('many'), CreateFloatNode(1.0),CreateStringNode('one'), CreateFloatNode(2.0),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','many',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestBooleanTag; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'), CreateBoolNode(True),CreateStringNode('one'), CreateBoolNode(False),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','one',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestBooleanTagDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateBoolNode(True),CreateStringNode('unknown'), CreateBoolNode(False),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','unknown',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestDateTimeTag; begin FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date),CreateStringNode('later'), CreateDateTimeNode(Date),CreateStringNode('today'), CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','today',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestDateTimeTagDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateDateTimeNode(Date+2),CreateStringNode('later'), CreateDateTimeNode(Date),CreateStringNode('today'), CreateDateTimeNode(Date+1),CreateStringNode('tomorrow')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','later',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestIntegerValue; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateIntNode(0), CreateIntNode(1),CreateIntNode(-1), CreateIntNode(2),CreateIntNode(-2)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',-1,FN.NodeValue.ResInteger); end; procedure TTestCaseOperation.TestIntegerValueDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateIntNode(0), CreateIntNode(1),CreateIntNode(-1), CreateIntNode(2),CreateIntNode(-2)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtInteger,FN.NodeType); AssertEquals('Correct result',0,FN.NodeValue.ResInteger); end; procedure TTestCaseOperation.TestStringValue; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateStringNode('many'), CreateIntNode(1),CreateStringNode('one'), CreateIntNode(2),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','one',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestStringValueDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateStringNode('many'), CreateIntNode(1),CreateStringNode('one'), CreateIntNode(2),CreateStringNode('two')])); AssertNodeOK(FN); AssertEquals('Correct node type',rtString,FN.NodeType); AssertEquals('Correct result','many',FN.NodeValue.ResString); end; procedure TTestCaseOperation.TestFloatValue; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateFloatNode(0.0), CreateIntNode(1),CreateFloatNode(2.0), CreateIntNode(2),CreateFloatNode(1.0)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtFloat,FN.NodeType); AssertEquals('Correct result',2.0,FN.NodeValue.ResFloat); end; procedure TTestCaseOperation.TestFloatValueDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateFloatNode(0.0), CreateIntNode(1),CreateFloatNode(2.0), CreateIntNode(2),CreateFloatNode(1.0)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtFloat,FN.NodeType); AssertEquals('Correct result',0.0,FN.NodeValue.ResFloat); end; procedure TTestCaseOperation.TestBooleanValue; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateBoolNode(False), CreateIntNode(1),CreateBoolNode(True), CreateIntNode(2),CreateBoolNode(False)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtBoolean,FN.NodeType); AssertEquals('Correct result',True,FN.NodeValue.ResBoolean); end; procedure TTestCaseOperation.TestBooleanValueDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateBoolNode(False), CreateIntNode(1),CreateBoolNode(True), CreateIntNode(2),CreateBoolNode(False)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtBoolean,FN.NodeType); AssertEquals('Correct result',False,FN.NodeValue.ResBoolean); end; procedure TTestCaseOperation.TestDateTimeValue; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(1),CreateDateTimeNode(Date+1), CreateIntNode(1),CreateDateTimeNode(Date), CreateIntNode(2),CreateDateTimeNode(Date-1)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtDateTime,FN.NodeType); AssertEquals('Correct result',Date,FN.NodeValue.ResDateTime); end; procedure TTestCaseOperation.TestDateTimeValueDefault; begin FN:=TCaseOperation.Create(CreateArgs([CreateIntNode(3),CreateDateTimeNode(Date+1), CreateIntNode(1),CreateDateTimeNode(Date), CreateIntNode(2),CreateDateTimeNode(Date-1)])); AssertNodeOK(FN); AssertEquals('Correct node type',rtDateTime,FN.NodeType); AssertEquals('Correct result',Date+1,FN.NodeValue.ResDateTime); end; procedure TTestCaseOperation.TestDestroy; begin FN:=TCaseOperation.Create(CreateArgs([TMyDestroyNode.CreateTest(Self), TMyDestroyNode.CreateTest(Self), TMyDestroyNode.CreateTest(Self), TMyDestroyNode.CreateTest(Self)])); FreeAndNil(FN); AssertEquals('Destroy called for operand',4,self.FDestroyCalled) end; initialization RegisterTests([TTestExpressionScanner, TTestDestroyNode, TTestConstExprNode,TTestNegateExprNode, TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode, TTestNotNode,TTestEqualNode,TTestUnEqualNode, TTestIfOperation,TTestCaseOperation, TTestLessThanNode,TTestLessThanEqualNode, TTestLargerThanNode,TTestLargerThanEqualNode, TTestAddNode,TTestSubtractNode, TTestMultiplyNode,TTestDivideNode, TTestIntToFloatNode,TTestIntToDateTimeNode, TTestFloatToDateTimeNode, TTestParserExpressions, TTestParserBooleanOperations, TTestParserOperands, TTestParserTypeMatch, TTestParserVariables,TTestParserFunctions, TTestBuiltinsManager,TTestBuiltins]); end.