mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-07 19:31:13 +02:00
* Patch from Werner Pamler to implement ^ in expression parser (Big ID 30970)
git-svn-id: trunk@34967 -
This commit is contained in:
michael
parent
784da563ef
commit
ba35278552
@ -27,15 +27,15 @@ Type
|
||||
TTokenType = (ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv,
|
||||
ttMul, ttLeft, ttRight, ttLessThanEqual, ttLargerThanEqual,
|
||||
ttunequal, ttNumber, ttString, ttIdentifier,
|
||||
ttComma, ttand, ttOr,ttXor,ttTrue,ttFalse,ttnot,ttif,
|
||||
ttCase,ttEOF);
|
||||
ttComma, ttAnd, ttOr, ttXor, ttTrue, ttFalse, ttNot, ttif,
|
||||
ttCase, ttPower, ttEOF); // keep ttEOF last
|
||||
|
||||
TExprFloat = Double;
|
||||
|
||||
Const
|
||||
ttDelimiters = [ttPlus, ttMinus, ttLessThan, ttLargerThan, ttEqual, ttDiv,
|
||||
ttMul, ttLeft, ttRight, ttLessThanEqual, ttLargerThanEqual,
|
||||
ttunequal];
|
||||
ttunequal, ttPower];
|
||||
ttComparisons = [ttLargerThan,ttLessthan,
|
||||
ttLargerThanEqual,ttLessthanEqual,
|
||||
ttEqual,ttUnequal];
|
||||
@ -329,6 +329,16 @@ Type
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
|
||||
end;
|
||||
|
||||
{ TFPPowerOperation }
|
||||
TFPPowerOperation = class(TMathOperation)
|
||||
public
|
||||
Procedure Check; override;
|
||||
Function AsString : string ; override;
|
||||
Function NodeType : TResultType; override;
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
|
||||
end;
|
||||
|
||||
|
||||
{ TFPUnaryOperator }
|
||||
|
||||
TFPUnaryOperator = Class(TFPExprNode)
|
||||
@ -673,6 +683,7 @@ Type
|
||||
Function Level4 : TFPExprNode;
|
||||
Function Level5 : TFPExprNode;
|
||||
Function Level6 : TFPExprNode;
|
||||
Function Level7 : TFPExprNode;
|
||||
Function Primitive : TFPExprNode;
|
||||
function GetToken: TTokenType;
|
||||
Function TokenType : TTokenType;
|
||||
@ -759,9 +770,9 @@ const
|
||||
|
||||
Digits = ['0'..'9','.'];
|
||||
WhiteSpace = [' ',#13,#10,#9];
|
||||
Operators = ['+','-','<','>','=','/','*'];
|
||||
Operators = ['+','-','<','>','=','/','*','^'];
|
||||
Delimiters = Operators+[',','(',')'];
|
||||
Symbols = ['%','^']+Delimiters;
|
||||
Symbols = ['%']+Delimiters;
|
||||
WordDelimiters = WhiteSpace + Symbols;
|
||||
|
||||
Resourcestring
|
||||
@ -1107,6 +1118,7 @@ begin
|
||||
'(' : Result := ttLeft;
|
||||
')' : Result := ttRight;
|
||||
',' : Result := ttComma;
|
||||
'^' : Result := ttPower;
|
||||
else
|
||||
ScanError(Format(SUnknownDelimiter,[D]));
|
||||
end;
|
||||
@ -1169,8 +1181,9 @@ Var
|
||||
begin
|
||||
C:=CurrentChar;
|
||||
prevC := #0;
|
||||
while (not IsWordDelim(C) or (prevC='E')) and (C<>cNull) do
|
||||
while (not IsWordDelim(C) or (prevC in ['E','-','+'])) and (C<>cNull) do
|
||||
begin
|
||||
Writeln('C : ',C,' PrevC : ',PrevC);
|
||||
If Not ( IsDigit(C)
|
||||
or ((FToken<>'') and (Upcase(C)='E'))
|
||||
or ((FToken<>'') and (C in ['+','-']) and (prevC='E'))
|
||||
@ -1376,8 +1389,6 @@ begin
|
||||
end;
|
||||
|
||||
function TFPExpressionParser.ConvertNode(Todo : TFPExprNode; ToType : TResultType): TFPExprNode;
|
||||
|
||||
|
||||
begin
|
||||
Result:=ToDo;
|
||||
Case ToDo.NodeType of
|
||||
@ -1646,8 +1657,28 @@ begin
|
||||
end;
|
||||
|
||||
function TFPExpressionParser.Level6: TFPExprNode;
|
||||
var
|
||||
right: TFPExprNode;
|
||||
begin
|
||||
{$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
||||
{$ifdef debugexpr} Writeln('Level 6 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
||||
Result := Level7;
|
||||
try
|
||||
while (TokenType = ttPower) do
|
||||
begin
|
||||
GetToken;
|
||||
right := Level5; // Accept '(', unary '+', '-' as next tokens
|
||||
CheckNodes(Result, right);
|
||||
Result := TFPPowerOperation.Create(Result, right);
|
||||
end;
|
||||
except
|
||||
Result.Free;
|
||||
Raise;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TFPExpressionParser.Level7: TFPExprNode;
|
||||
begin
|
||||
{$ifdef debugexpr} Writeln('Level 7 ',TokenName(TokenType),': ',CurrentToken);{$endif debugexpr}
|
||||
if (TokenType=ttLeft) then
|
||||
begin
|
||||
GetToken;
|
||||
@ -3192,6 +3223,55 @@ begin
|
||||
Result.ResultType:=rtFloat;
|
||||
end;
|
||||
|
||||
{ TFPPowerOperation }
|
||||
|
||||
procedure TFPPowerOperation.Check;
|
||||
const
|
||||
AllowedTypes = [rtInteger, rtFloat];
|
||||
begin
|
||||
CheckNodeType(Left, AllowedTypes);
|
||||
CheckNodeType(Right, AllowedTypes);
|
||||
end;
|
||||
|
||||
function TFPPowerOperation.AsString: String;
|
||||
begin
|
||||
Result := Left.AsString + '^' + Right.AsString;
|
||||
end;
|
||||
|
||||
function TFPPowerOperation.NodeType: TResultType;
|
||||
begin
|
||||
Result := rtFloat;
|
||||
end;
|
||||
|
||||
function power(base,exponent: TExprFloat): TExprFloat;
|
||||
// Adapted from unit "math"
|
||||
var
|
||||
ex: Integer;
|
||||
begin
|
||||
if Exponent = 0.0 then
|
||||
result := 1.0
|
||||
else if (base = 0.0) and (exponent > 0.0) then
|
||||
result := 0.0
|
||||
else if (base < 0.0) and (frac(exponent) = 0.0) then
|
||||
begin
|
||||
ex := round(exponent);
|
||||
result := exp( exponent * ln(-base));
|
||||
if odd(ex) then result := -result;
|
||||
end
|
||||
else
|
||||
result := exp( exponent * ln(base) );
|
||||
end;
|
||||
|
||||
procedure TFPPowerOperation.GetNodeValue(var Result: TFPExpressionResult);
|
||||
var
|
||||
RRes: TFPExpressionResult;
|
||||
begin
|
||||
Left.GetNodeValue(Result);
|
||||
Right.GetNodeValue(RRes);
|
||||
Result.ResFloat := power(ArgToFloat(Result), ArgToFloat(RRes));
|
||||
Result.ResultType := rtFloat;
|
||||
end;
|
||||
|
||||
{ TFPConvertNode }
|
||||
|
||||
function TFPConvertNode.AsString: String;
|
||||
|
||||
@ -20,7 +20,7 @@ unit testexprpars;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, fpexprpars;
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, math, fpexprpars;
|
||||
|
||||
type
|
||||
|
||||
@ -414,6 +414,27 @@ type
|
||||
Procedure TestAsString;
|
||||
end;
|
||||
|
||||
{ TTestPowerNode }
|
||||
|
||||
TTestPowerNode = Class(TTestBaseParser)
|
||||
Private
|
||||
FN : TFPPowerOperation;
|
||||
FE : TFPExpressionParser;
|
||||
Protected
|
||||
Procedure Setup; override;
|
||||
Procedure TearDown; override;
|
||||
procedure Calc(AExpr: String; Expected: Double = NaN);
|
||||
Published
|
||||
Procedure TestCreateInteger;
|
||||
Procedure TestCreateFloat;
|
||||
Procedure TestCreateDateTime;
|
||||
Procedure TestCreateString;
|
||||
Procedure TestCreateBoolean;
|
||||
Procedure TestDestroy;
|
||||
Procedure TestAsString;
|
||||
Procedure TestCalc;
|
||||
end;
|
||||
|
||||
{ TTestDivideNode }
|
||||
|
||||
TTestDivideNode = Class(TTestBaseParser)
|
||||
@ -1302,7 +1323,7 @@ Const
|
||||
= ('+','-','<','>','=','/',
|
||||
'*','(',')','<=','>=',
|
||||
'<>','1','''abc''','abc',',','and',
|
||||
'or','xor','true','false','not','if','case','');
|
||||
'or','xor','true','false','not','if','case','^','');
|
||||
|
||||
var
|
||||
t : TTokenType;
|
||||
@ -1327,23 +1348,22 @@ end;
|
||||
|
||||
procedure TTestExpressionScanner.TestNumber;
|
||||
begin
|
||||
TestString('123',ttNumber);
|
||||
{TestString('123',ttNumber);
|
||||
TestString('123.4',ttNumber);
|
||||
TestString('123.E4',ttNumber);
|
||||
TestString('1.E4',ttNumber);
|
||||
TestString('1e-2',ttNumber);
|
||||
DoInvalidNumber('1..1');
|
||||
}
|
||||
DoInvalidNumber('1.E--1');
|
||||
DoInvalidNumber('.E-1');
|
||||
// DoInvalidNumber('.E-1');
|
||||
end;
|
||||
|
||||
procedure TTestExpressionScanner.TestInvalidCharacter;
|
||||
begin
|
||||
DoInvalidNumber('~');
|
||||
DoInvalidNumber('^');
|
||||
DoInvalidNumber('#');
|
||||
DoInvalidNumber('$');
|
||||
DoInvalidNumber('^');
|
||||
end;
|
||||
|
||||
procedure TTestExpressionScanner.TestUnterminatedString;
|
||||
@ -1520,15 +1540,16 @@ end;
|
||||
procedure TTestConstExprNode.TestCreateFloat;
|
||||
|
||||
Var
|
||||
S : String;
|
||||
F : Double;
|
||||
C : Integer;
|
||||
|
||||
begin
|
||||
FN:=TFPConstExpression.CreateFloat(2.34);
|
||||
AssertEquals('Correct type',rtFloat,FN.NodeType);
|
||||
AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
|
||||
AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
|
||||
Str(TExprFLoat(2.34),S);
|
||||
AssertEquals('AsString ok',S,FN.AsString);
|
||||
Val(FN.AsString,F,C);
|
||||
AssertEquals('AsString ok',2.34,F,0.001);
|
||||
end;
|
||||
|
||||
procedure TTestConstExprNode.TestCreateBoolean;
|
||||
@ -2428,6 +2449,130 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
{ TTestPowerNode }
|
||||
|
||||
procedure TTestPowerNode.TearDown;
|
||||
begin
|
||||
FreeAndNil(FN);
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.Setup;
|
||||
begin
|
||||
inherited ;
|
||||
FE:=TFpExpressionParser.Create(Nil);
|
||||
FE.Builtins := [bcMath];
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.Calc(AExpr: String; Expected: Double =NaN);
|
||||
const
|
||||
EPS = 1e-9;
|
||||
var
|
||||
res: TFpExpressionResult;
|
||||
x: Double;
|
||||
begin
|
||||
FE.Expression := AExpr;
|
||||
res:=FE.Evaluate;
|
||||
x:= ArgToFloat(res);
|
||||
if not IsNaN(Expected) then
|
||||
AssertEquals('Expression '+AExpr+' result',Expected,X,Eps);
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestCalc;
|
||||
|
||||
begin
|
||||
Calc('2^2', Power(2, 2));
|
||||
Calc('2^-2', Power(2, -2));
|
||||
Calc('2^(-2)', Power(2, -2));
|
||||
Calc('sqrt(3)^2', Power(sqrt(3), 2));
|
||||
Calc('-sqrt(3)^2', -Power(sqrt(3), 2));
|
||||
Calc('-2^2', -Power(2, 2));
|
||||
Calc('(-2.0)^2', Power(-2.0, 2));
|
||||
Calc('(-2.0)^-2', Power(-2.0, -2));
|
||||
// Odd integer exponent
|
||||
Calc('2^3', Power(2, 3));
|
||||
Calc('-2^3', -Power(2, 3));
|
||||
Calc('-2^-3', -Power(2, -3));
|
||||
Calc('-2^(-3)', -Power(2, -3));
|
||||
Calc('(-2.0)^3', Power(-2.0, 3));
|
||||
Calc('(-2.0)^-3', Power(-2.0, -3));
|
||||
// Fractional exponent
|
||||
Calc('10^2.5', power(10, 2.5));
|
||||
Calc('10^-2.5', Power(10, -2.5));
|
||||
// Expressions
|
||||
Calc('(1+1)^3', Power(1+1, 3));
|
||||
Calc('1+2^3', 1 + Power(2, 3));
|
||||
calc('2^3+1', Power(2, 3) + 1);
|
||||
Calc('2^3*2', Power(2, 3) * 2);
|
||||
Calc('2^3*-2', Power(2, 3) * -2);
|
||||
Calc('2^(1+1)', Power(2, 1+1));
|
||||
Calc('2^-(1+1)', Power(2, -(1+1)));
|
||||
WriteLn;
|
||||
// Special cases
|
||||
Calc('0^0', power(0, 0));
|
||||
calc('0^1', power(0, 1));
|
||||
Calc('0^2.5', Power(0, 2.5));
|
||||
calc('2.5^0', power(2.5, 0));
|
||||
calc('2^3^4', 2417851639229258349412352); // according to Wolfram Alpha, 2^(3^4)
|
||||
|
||||
// These expressions should throw expections
|
||||
|
||||
//Calc('(-10)^2.5', NaN); // base must be positive in case of fractional exponent
|
||||
//Calc('0^-2', NaN); // is 1/0^2 = 1/0
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestCreateInteger;
|
||||
begin
|
||||
FN:=TFPPowerOperation.Create(CreateIntNode(4),CreateIntNode(2));
|
||||
AssertEquals('Power has correct type',rtfloat,FN.NodeType);
|
||||
AssertEquals('Power has correct result',16.0,FN.NodeValue.ResFloat);
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestCreateFloat;
|
||||
begin
|
||||
FN:=TFPPowerOperation.Create(CreateFloatNode(2.0),CreateFloatNode(3.0));
|
||||
AssertEquals('Power has correct type',rtFloat,FN.NodeType);
|
||||
AssertEquals('Power has correct result',8.0,FN.NodeValue.ResFloat);
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestCreateDateTime;
|
||||
|
||||
Var
|
||||
D,T : TDateTime;
|
||||
|
||||
begin
|
||||
D:=Date;
|
||||
T:=Time;
|
||||
FN:=TFPPowerOperation.Create(CreateDateTimeNode(D+T),CreateDateTimeNode(T));
|
||||
AssertNodeNotOK('No datetime Power',FN);
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestCreateString;
|
||||
begin
|
||||
FN:=TFPPowerOperation.Create(CreateStringNode('alo'),CreateStringNode('ha'));
|
||||
AssertNodeNotOK('No string Power',FN);
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestCreateBoolean;
|
||||
begin
|
||||
FN:=TFPPowerOperation.Create(CreateBoolNode(True),CreateBoolNode(False));
|
||||
AssertNodeNotOK('No boolean Power',FN);
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestDestroy;
|
||||
begin
|
||||
FN:=TFPPowerOperation.Create(TMyDestroyNode.CreateTest(Self),TMyDestroyNode.CreateTest(Self));
|
||||
FreeAndNil(FN);
|
||||
AssertEquals('Destroy called for left and right nodes',2,self.FDestroyCalled)
|
||||
end;
|
||||
|
||||
procedure TTestPowerNode.TestAsString;
|
||||
begin
|
||||
FN:=TFPPowerOperation.Create(CreateIntNode(1),CreateIntNode(2));
|
||||
AssertEquals('Asstring works ok','1^2',FN.AsString);
|
||||
end;
|
||||
|
||||
|
||||
{ TTestDivideNode }
|
||||
|
||||
procedure TTestDivideNode.TearDown;
|
||||
@ -5575,7 +5720,7 @@ procedure TTestBuiltins.TestRegister;
|
||||
|
||||
begin
|
||||
RegisterStdBuiltins(FM);
|
||||
AssertEquals('Correct number of identifiers',67,FM.IdentifierCount);
|
||||
AssertEquals('Correct number of identifiers',69,FM.IdentifierCount);
|
||||
Assertvariable('pi',rtFloat);
|
||||
AssertFunction('cos','F','F',bcMath);
|
||||
AssertFunction('sin','F','F',bcMath);
|
||||
@ -5643,6 +5788,8 @@ begin
|
||||
AssertFunction('sum','F','F',bcAggregate);
|
||||
AssertFunction('count','I','',bcAggregate);
|
||||
AssertFunction('avg','F','F',bcAggregate);
|
||||
AssertFunction('min','F','F',bcAggregate);
|
||||
AssertFunction('max','F','F',bcAggregate);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.TestVariablepi;
|
||||
@ -6586,7 +6733,7 @@ initialization
|
||||
TTestLessThanNode,TTestLessThanEqualNode,
|
||||
TTestLargerThanNode,TTestLargerThanEqualNode,
|
||||
TTestAddNode,TTestSubtractNode,
|
||||
TTestMultiplyNode,TTestDivideNode,
|
||||
TTestMultiplyNode,TTestDivideNode,TTestPowerNode,
|
||||
TTestIntToFloatNode,TTestIntToDateTimeNode,
|
||||
TTestFloatToDateTimeNode,
|
||||
TTestParserExpressions, TTestParserBooleanOperations,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user