mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-22 08:01:35 +02:00
* Allow hex, octal and binary notation for expression parser (patch from bug ID #33216)
git-svn-id: trunk@38326 -
This commit is contained in:
michael
parent
4a0072d43d
commit
84377291b4
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user