From 84377291b4d157ad330edfe8c21cb2f4ca168322 Mon Sep 17 00:00:00 2001 From: michael Date: Sat, 24 Feb 2018 10:59:44 +0000 Subject: [PATCH] * Allow hex, octal and binary notation for expression parser (patch from bug ID #33216) git-svn-id: trunk@38326 - --- packages/fcl-base/src/fpexprpars.pp | 106 ++++++++++++++++++++---- packages/fcl-base/tests/testexprpars.pp | 87 +++++++++++++++++-- 2 files changed, 167 insertions(+), 26 deletions(-) diff --git a/packages/fcl-base/src/fpexprpars.pp b/packages/fcl-base/src/fpexprpars.pp index 669b6414c6..bf30ae60c2 100644 --- a/packages/fcl-base/src/fpexprpars.pp +++ b/packages/fcl-base/src/fpexprpars.pp @@ -47,6 +47,8 @@ Type TFPExprFunction = Class; TFPExprFunctionClass = Class of TFPExprFunction; + TNumberKind = (nkDecimal, nkHex, nkOctal, nkBinary); + { TFPExpressionScanner } TFPExpressionScanner = Class(TObject) @@ -62,14 +64,14 @@ Type protected procedure SetSource(const AValue: String); virtual; function DoIdentifier: TTokenType; - function DoNumber: TTokenType; + function DoNumber(AKind: TNumberKind): TTokenType; function DoDelimiter: TTokenType; function DoString: TTokenType; Function NextPos : Char; // inline; procedure SkipWhiteSpace; // inline; function IsWordDelim(C : Char) : Boolean; // inline; function IsDelim(C : Char) : Boolean; // inline; - function IsDigit(C : Char) : Boolean; // inline; + function IsDigit(C : Char; AKind: TNumberKind) : Boolean; // inline; function IsAlpha(C : Char) : Boolean; // inline; public Constructor Create; @@ -591,6 +593,7 @@ Type TAggregateExpr = Class(TFPExprFunction) Protected FResult : TFPExpressionResult; + public Class Function IsAggregate : Boolean; override; Procedure GetNodeValue(var Result : TFPExpressionResult); override; end; @@ -781,14 +784,23 @@ uses typinfo; const cNull=#0; cSingleQuote = ''''; + cHexIdentifier = '$'; + cOctalIdentifier = '&'; + cBinaryIdentifier = '%'; Digits = ['0'..'9','.']; + HexDigits = ['0'..'9', 'A'..'F', 'a'..'f']; + OctalDigits = ['0'..'7']; + BinaryDigits = ['0', '1']; WhiteSpace = [' ',#13,#10,#9]; Operators = ['+','-','<','>','=','/','*','^']; Delimiters = Operators+[',','(',')']; Symbols = ['%']+Delimiters; WordDelimiters = WhiteSpace + Symbols; +var + FileFormatSettings: TFormatSettings; + Resourcestring SBadQuotes = 'Unterminated string'; SUnknownDelimiter = 'Unknown delimiter character: "%s"'; @@ -1115,9 +1127,14 @@ begin Result:=C in Delimiters; end; -function TFPExpressionScanner.IsDigit(C: Char): Boolean; +function TFPExpressionScanner.IsDigit(C: Char; AKind: TNumberKind): Boolean; begin - Result:=C in Digits; + case AKind of + nkDecimal: Result := C in Digits; + nkHex : Result := C in HexDigits; + nkOctal : Result := C in OctalDigits; + nkBinary : Result := C in BinaryDigits; + end; end; Procedure TFPExpressionScanner.SkipWhiteSpace; @@ -1215,7 +1232,21 @@ begin Result:=#0; end; -Function TFPExpressionScanner.DoNumber : TTokenType; +procedure Val(const S: string; out V: TExprFloat; out Code: Integer); +var + L64: Int64; +begin + if (S <> '') and (S[1] in ['&', '$', '%']) then + begin + System.Val(S, L64, Code); + if Code = 0 then + V := L64 + end + else + System.Val(S, V, Code); +end; + +Function TFPExpressionScanner.DoNumber(AKind: TNumberKind) : TTokenType; Var C : Char; @@ -1223,16 +1254,38 @@ Var I : Integer; prevC: Char; + function ValidDigit(C: Char; AKind: TNumberKind): Boolean; + begin + Result := IsDigit(C, AKind); + if (not Result) then + case AKind of + nkDecimal: + Result := ((FToken <> '') and (UpCase(C)='E')) or + ((FToken <> '') and (C in ['+','-']) and (prevC='E')); + nkHex: + Result := (C = cHexIdentifier) and (prevC = #0); + nkOctal: + Result := (C = cOctalIdentifier) and (prevC = #0); + nkBinary: + Result := (C = cBinaryIdentifier) and (prevC = #0); + end; + end; + begin C:=CurrentChar; prevC := #0; - while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do - begin - If Not ( IsDigit(C) - or ((FToken<>'') and (Upcase(C)='E')) - or ((FToken<>'') and (C in ['+','-']) and (prevC='E')) - ) - then + while (C <> cNull) do + begin + if IsWordDelim(C) then + case AKind of + nkDecimal: + if not (prevC in ['E','-','+']) then break; + nkHex, nkOctal: + break; + nkBinary: + if (prevC <> #0) then break; // allow '%' as first char + end; + if not ValidDigit(C, AKind) then ScanError(Format(SErrInvalidNumberChar,[C])); FToken := FToken+C; prevC := Upcase(C); @@ -1306,8 +1359,14 @@ begin Result:=DoDelimiter else if (C=cSingleQuote) then Result:=DoString - else if IsDigit(C) then - Result:=DoNumber + else if (C=cHexIdentifier) then + Result := DoNumber(nkHex) + else if (C=cOctalIdentifier) then + Result := DoNumber(nkOctal) + else if (C=cBinaryIdentifier) then + Result := DoNumber(nkBinary) + else if IsDigit(C, nkDecimal) then + Result:=DoNumber(nkDecimal) else if IsAlpha(C) or (C='"') then Result:=DoIdentifier else @@ -2112,8 +2171,8 @@ begin Case FValue.ResultType of rtBoolean : FValue.ResBoolean:=FStringValue='True'; rtInteger : FValue.ResInteger:=StrToInt(AValue); - rtFloat : FValue.ResFloat:=StrToFloat(AValue); - rtDateTime : FValue.ResDateTime:=StrToDateTime(AValue); + rtFloat : FValue.ResFloat:=StrToFloat(AValue, FileFormatSettings); + rtDateTime : FValue.ResDateTime:=StrToDateTime(AValue, FileFormatSettings); rtString : FValue.ResString:=AValue; end else @@ -2223,8 +2282,8 @@ begin else Result:='False'; rtInteger : Result:=IntToStr(FValue.ResInteger); - rtFloat : Result:=FloatToStr(FValue.ResFloat); - rtDateTime : Result:=FormatDateTime('cccc',FValue.ResDateTime); + rtFloat : Result:=FloatToStr(FValue.ResFloat, FileFormatSettings); + rtDateTime : Result:=FormatDateTime('cccc',FValue.ResDateTime, FileFormatSettings); rtString : Result:=FValue.ResString; end; end; @@ -4112,8 +4171,19 @@ begin FCategory:=(Source as TFPBuiltInExprIdentifierDef).Category; end; +procedure InitFileFormatSettings; +begin + FileFormatSettings := DefaultFormatSettings; + FileFormatSettings.DecimalSeparator := '.'; + FileFormatSettings.DateSeparator := '-'; + FileFormatSettings.TimeSeparator := ':'; + FileFormatsettings.ShortDateFormat := 'yyyy-mm-dd'; + FileFormatSettings.LongTimeFormat := 'hh:nn:ss'; +end; + initialization RegisterStdBuiltins(BuiltinIdentifiers); + InitFileFormatSettings; finalization FreeBuiltins; diff --git a/packages/fcl-base/tests/testexprpars.pp b/packages/fcl-base/tests/testexprpars.pp index 7526a96a4d..bb93c74df0 100644 --- a/packages/fcl-base/tests/testexprpars.pp +++ b/packages/fcl-base/tests/testexprpars.pp @@ -530,6 +530,7 @@ type private Published Procedure TestCreate; + Procedure TestNumberValues; Procedure TestSimpleNodeFloat; procedure TestSimpleNodeInteger; procedure TestSimpleNodeBooleanTrue; @@ -1320,10 +1321,19 @@ procedure TTestExpressionScanner.TestTokens; Const TestStrings : Array[TTokenType] of String + (* + TTokenType = (ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv, + ttMod, ttMul, ttLeft, ttRight, ttLessThanEqual, + ttLargerThanEqual, ttunequal, ttNumber, ttString, ttIdentifier, + ttComma, ttAnd, ttOr, ttXor, ttTrue, ttFalse, ttNot, ttif, + ttCase, ttPower, ttEOF); // keep ttEOF last + + *) = ('+','-','<','>','=','/', - '*','(',')','<=','>=', - '<>','1','''abc''','abc',',','and', - 'or','xor','true','false','not','if','case','^',''); + 'mod','*','(',')','<=', + '>=', '<>','1','''abc''','abc', + ',','and', 'or','xor','true','false','not', + 'if','case','^',''); var t : TTokenType; @@ -1348,17 +1358,23 @@ end; procedure TTestExpressionScanner.TestNumber; begin - {TestString('123',ttNumber); + TestString('123',ttNumber); + TestString('$FF',ttNumber); + TestString('&77',ttNumber); + TestString('%11111111',ttNumber); TestString('123.4',ttNumber); TestString('123.E4',ttNumber); TestString('1.E4',ttNumber); TestString('1e-2',ttNumber); + DoInValidNumber('$GG'); + DoInvalidNumber('&88'); + DoInvalidNumber('%22'); DoInvalidNumber('1..1'); -} DoInvalidNumber('1.E--1'); // DoInvalidNumber('.E-1'); end; + procedure TTestExpressionScanner.TestInvalidCharacter; begin DoInvalidNumber('~'); @@ -2843,6 +2859,60 @@ begin AssertEquals('No identifiers',0,FP.Identifiers.Count); end; +procedure TTestParserExpressions.TestNumberValues; + + Procedure DoTest(E : String; V : integer); + + var + res: TFPExpressionResult; + + begin + FP.Expression:=E; + res := FP.Evaluate; + AssertTrue('Expression '+E+': Result is a number', Res.ResultType in [rtInteger,rtFloat]); + AssertTrue('Expression '+E+': Correct value', ArgToFloat(res)=V); + end; + + +begin + // Decimal numbers + DoTest('1', 1); + DoTest('1E2', 100); + DoTest('1.0/1E-2', 100); + // DoTest('200%', 2); + WriteLn; + // Hex numbers + DoTest('$0001', 1); + DoTest('-$01', -1); + DoTest('$A', 10); + DoTest('$FF', 255); + DoTest('$fe', 254); + DoTest('$FFFF', $FFFF); + DoTest('1E2', 100); + DoTest('$E', 14); + DoTest('$D+1E2', 113); + DoTest('$0A-$0B', -1); + // Hex and variables + FP.Identifiers.AddVariable('a', rtInteger, '1'); + FP.Identifiers.AddVariable('b', rtInteger, '$B'); + DoTest('a', 1); + DoTest('b', $B); + DoTest('$A+a', 11); + DoTest('$B-b', 0); + WriteLn; + // Octal numbers + DoTest('&10', 8); + DoTest('&10+10', 18); + // Mixed hex and octal expression + DoTest('&10-$0008', 0); + WriteLn; + // Binary numbers + DoTest('%1', 1); + DoTest('%11', 3); + DoTest('%1000', 8); + +end; + procedure TTestParserExpressions.TestSimpleNodeFloat; begin @@ -4343,7 +4413,7 @@ begin 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); + AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value); end; procedure TTestParserVariables.AddVariabletwice; @@ -5547,7 +5617,7 @@ begin 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); + AssertEquals('Variable has correct value',FormatDateTime('yyyy-mm-dd hh:nn:ss',D),I.Value); end; procedure TTestBuiltinsManager.TestFunction1; @@ -5720,7 +5790,6 @@ procedure TTestBuiltins.TestRegister; begin RegisterStdBuiltins(FM); - AssertEquals('Correct number of identifiers',69,FM.IdentifierCount); Assertvariable('pi',rtFloat); AssertFunction('cos','F','F',bcMath); AssertFunction('sin','F','F',bcMath); @@ -5785,11 +5854,13 @@ begin AssertFunction('strtotimedef','D','SD',bcConversion); AssertFunction('strtodatetime','D','S',bcConversion); AssertFunction('strtodatetimedef','D','SD',bcConversion); + AssertFunction('formatfloat','S','SF',bcConversion); AssertFunction('sum','F','F',bcAggregate); AssertFunction('count','I','',bcAggregate); AssertFunction('avg','F','F',bcAggregate); AssertFunction('min','F','F',bcAggregate); AssertFunction('max','F','F',bcAggregate); + AssertEquals('Correct number of identifiers',70,FM.IdentifierCount); end; procedure TTestBuiltins.TestVariablepi;