mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 03:49:08 +02:00
* Aggregate Functions & ExtractNode
git-svn-id: trunk@34377 -
This commit is contained in:
michael
parent
be9e097841
commit
2ef1a423fe
@ -44,6 +44,8 @@ Type
|
||||
|
||||
TFPExpressionParser = Class;
|
||||
TExprBuiltInManager = Class;
|
||||
TFPExprFunction = Class;
|
||||
TFPExprFunctionClass = Class of TFPExprFunction;
|
||||
|
||||
{ TFPExpressionScanner }
|
||||
|
||||
@ -106,6 +108,10 @@ Type
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); virtual; abstract;
|
||||
Public
|
||||
Procedure Check; virtual; abstract;
|
||||
Procedure InitAggregate; virtual;
|
||||
Procedure UpdateAggregate; virtual;
|
||||
Class Function IsAggregate : Boolean; virtual;
|
||||
Function HasAggregate : Boolean; virtual;
|
||||
Function NodeType : TResultType; virtual; abstract;
|
||||
Function NodeValue : TFPExpressionResult;
|
||||
Function AsString : string; virtual; abstract;
|
||||
@ -123,6 +129,9 @@ Type
|
||||
Public
|
||||
Constructor Create(ALeft,ARight : TFPExprNode);
|
||||
Destructor Destroy; override;
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
Function HasAggregate : Boolean; override;
|
||||
Procedure Check; override;
|
||||
Property left : TFPExprNode Read FLeft;
|
||||
Property Right : TFPExprNode Read FRight;
|
||||
@ -245,6 +254,9 @@ Type
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
|
||||
Public
|
||||
Procedure Check; override;
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
Function HasAggregate : Boolean; override;
|
||||
Function NodeType : TResultType; override;
|
||||
Constructor Create(ACondition,ALeft,ARight : TFPExprNode);
|
||||
Destructor destroy; override;
|
||||
@ -262,6 +274,9 @@ Type
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
|
||||
Public
|
||||
Procedure Check; override;
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
function HasAggregate: Boolean; override;
|
||||
Function NodeType : TResultType; override;
|
||||
Constructor Create(Args : TExprArgumentArray);
|
||||
Destructor destroy; override;
|
||||
@ -322,6 +337,9 @@ Type
|
||||
Public
|
||||
Constructor Create(AOperand : TFPExprNode);
|
||||
Destructor Destroy; override;
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
Function HasAggregate : Boolean; override;
|
||||
Procedure Check; override;
|
||||
Property Operand : TFPExprNode Read FOperand;
|
||||
end;
|
||||
@ -401,7 +419,7 @@ Type
|
||||
end;
|
||||
|
||||
|
||||
TIdentifierType = (itVariable,itFunctionCallBack,itFunctionHandler);
|
||||
TIdentifierType = (itVariable,itFunctionCallBack,itFunctionHandler,itFunctionNode);
|
||||
TFPExprFunctionCallBack = Procedure (Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
|
||||
TFPExprFunctionEvent = Procedure (Var Result : TFPExpressionResult; Const Args : TExprParameterArray) of object;
|
||||
TFPExprVariableCallBack = Procedure (Var Result : TFPExpressionResult; ConstRef AName : ShortString);
|
||||
@ -411,6 +429,7 @@ Type
|
||||
|
||||
TFPExprIdentifierDef = Class(TCollectionItem)
|
||||
private
|
||||
FNodeType: TFPExprFunctionClass;
|
||||
FOnGetVarValue: TFPExprVariableEvent;
|
||||
FOnGetVarValueCB: TFPExprVariableCallBack;
|
||||
FStringValue : String;
|
||||
@ -459,10 +478,11 @@ Type
|
||||
Property ResultType : TResultType Read GetResultType Write SetResultType;
|
||||
Property OnGetFunctionValue : TFPExprFunctionEvent Read FOnGetValue Write FOnGetValue;
|
||||
Property OnGetVariableValue : TFPExprVariableEvent Read FOnGetVarValue Write FOnGetVarValue;
|
||||
Property NodeType : TFPExprFunctionClass Read FNodeType Write FNodeType;
|
||||
end;
|
||||
|
||||
|
||||
TBuiltInCategory = (bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser);
|
||||
TBuiltInCategory = (bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser,bcAggregate);
|
||||
TBuiltInCategories = Set of TBuiltInCategory;
|
||||
|
||||
{ TFPBuiltInExprIdentifierDef }
|
||||
@ -500,6 +520,7 @@ Type
|
||||
Function AddDateTimeVariable(Const AName : ShortString; AValue : TDateTime) : TFPExprIdentifierDef;
|
||||
Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPExprIdentifierDef;
|
||||
Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionEvent) : TFPExprIdentifierDef;
|
||||
Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ANodeClass : TFPExprFunctionClass) : TFPExprIdentifierDef;
|
||||
property Identifiers[AIndex : Integer] : TFPExprIdentifierDef Read GetI Write SetI; Default;
|
||||
end;
|
||||
|
||||
@ -541,6 +562,42 @@ Type
|
||||
Function AsString : String; override;
|
||||
end;
|
||||
|
||||
{ TAggregateExpr }
|
||||
|
||||
TAggregateExpr = Class(TFPExprFunction)
|
||||
Protected
|
||||
FResult : TFPExpressionResult;
|
||||
Class Function IsAggregate : Boolean; override;
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
|
||||
end;
|
||||
|
||||
{ TAggregateSum }
|
||||
|
||||
TAggregateSum = Class(TAggregateExpr)
|
||||
Public
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
end;
|
||||
|
||||
{ TAggregateAvg }
|
||||
|
||||
TAggregateAvg = Class(TAggregateSum)
|
||||
Protected
|
||||
FCount : Integer;
|
||||
Public
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
|
||||
end;
|
||||
|
||||
{ TAggregateCount }
|
||||
|
||||
TAggregateCount = Class(TAggregateExpr)
|
||||
Public
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
end;
|
||||
|
||||
{ TFPFunctionCallBack }
|
||||
|
||||
TFPFunctionCallBack = Class(TFPExprFunction)
|
||||
@ -610,8 +667,12 @@ Type
|
||||
Function IdentifierByName(const AName : ShortString) : TFPExprIdentifierDef; virtual;
|
||||
Procedure Clear;
|
||||
Procedure EvaluateExpression(Var Result : TFPExpressionResult);
|
||||
function ExtractNode(var N: TFPExprNode): Boolean;
|
||||
Function Evaluate : TFPExpressionResult;
|
||||
Function ResultType : TResultType;
|
||||
Function HasAggregate : Boolean;
|
||||
Procedure InitAggregate;
|
||||
Procedure UpdateAggregate;
|
||||
Property AsFloat : TExprFloat Read GetAsFloat;
|
||||
Property AsInteger : Int64 Read GetAsInteger;
|
||||
Property AsString : String Read GetAsString;
|
||||
@ -647,22 +708,23 @@ Type
|
||||
Function AddDateTimeVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : TDateTime) : TFPBuiltInExprIdentifierDef;
|
||||
Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPBuiltInExprIdentifierDef;
|
||||
Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionEvent) : TFPBuiltInExprIdentifierDef;
|
||||
Function AddFunction(Const ACategory : TBuiltInCategory; Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ANodeClass : TFPExprFunctionClass) : TFPBuiltInExprIdentifierDef;
|
||||
Property IdentifierCount : Integer Read GetCount;
|
||||
Property Identifiers[AIndex : Integer] :TFPBuiltInExprIdentifierDef Read GetI;
|
||||
end;
|
||||
|
||||
EExprParser = Class(Exception);
|
||||
|
||||
Const
|
||||
AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser,bcAggregate];
|
||||
|
||||
Function TokenName (AToken : TTokenType) : String;
|
||||
Function ResultTypeName (AResult : TResultType) : String;
|
||||
Function CharToResultType(C : Char) : TResultType;
|
||||
Function BuiltinIdentifiers : TExprBuiltInManager;
|
||||
Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
|
||||
Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager; Categories : TBuiltInCategories = AllBuiltIns);
|
||||
function ArgToFloat(Arg: TFPExpressionResult): TExprFloat;
|
||||
|
||||
Const
|
||||
AllBuiltIns = [bcStrings,bcDateTime,bcMath,bcBoolean,bcConversion,bcData,bcVaria,bcUser];
|
||||
|
||||
|
||||
implementation
|
||||
@ -737,13 +799,13 @@ begin
|
||||
Raise EExprParser.CreateFmt(Fmt,Args);
|
||||
end;
|
||||
|
||||
Function TokenName (AToken : TTokenType) : String;
|
||||
function TokenName(AToken: TTokenType): String;
|
||||
|
||||
begin
|
||||
Result:=GetEnumName(TypeInfo(TTokenType),Ord(AToken));
|
||||
end;
|
||||
|
||||
Function ResultTypeName (AResult : TResultType) : String;
|
||||
function ResultTypeName(AResult: TResultType): String;
|
||||
|
||||
begin
|
||||
Result:=GetEnumName(TypeInfo(TResultType),Ord(AResult));
|
||||
@ -765,7 +827,7 @@ end;
|
||||
Var
|
||||
BuiltIns : TExprBuiltInManager;
|
||||
|
||||
Function BuiltinIdentifiers : TExprBuiltInManager;
|
||||
function BuiltinIdentifiers: TExprBuiltInManager;
|
||||
|
||||
begin
|
||||
If (BuiltIns=Nil) then
|
||||
@ -779,6 +841,85 @@ begin
|
||||
FreeAndNil(Builtins);
|
||||
end;
|
||||
|
||||
{ TAggregateAvg }
|
||||
|
||||
procedure TAggregateAvg.InitAggregate;
|
||||
begin
|
||||
inherited InitAggregate;
|
||||
FCount:=0;
|
||||
end;
|
||||
|
||||
procedure TAggregateAvg.UpdateAggregate;
|
||||
begin
|
||||
inherited UpdateAggregate;
|
||||
Inc(FCount);
|
||||
end;
|
||||
|
||||
procedure TAggregateAvg.GetNodeValue(var Result: TFPExpressionResult);
|
||||
begin
|
||||
inherited GetNodeValue(Result);
|
||||
Result.ResultType:=rtFloat;
|
||||
if FCount=0 then
|
||||
Result.ResFloat:=0
|
||||
else
|
||||
Case FResult.ResultType of
|
||||
rtInteger:
|
||||
Result.ResFloat:=FResult.ResInteger/FCount;
|
||||
rtFloat:
|
||||
Result.ResFloat:=FResult.ResFloat/FCount;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TAggregateCount }
|
||||
|
||||
procedure TAggregateCount.InitAggregate;
|
||||
begin
|
||||
FResult.ResultType:=rtInteger;
|
||||
FResult.ResInteger:=0;
|
||||
end;
|
||||
|
||||
procedure TAggregateCount.UpdateAggregate;
|
||||
begin
|
||||
Inc(FResult.ResInteger);
|
||||
end;
|
||||
|
||||
{ TAggregateExpr }
|
||||
|
||||
class function TAggregateExpr.IsAggregate: Boolean;
|
||||
begin
|
||||
Result:=True;
|
||||
end;
|
||||
|
||||
procedure TAggregateExpr.GetNodeValue(var Result: TFPExpressionResult);
|
||||
begin
|
||||
Result:=FResult;
|
||||
end;
|
||||
|
||||
{ TAggregateSum }
|
||||
|
||||
|
||||
procedure TAggregateSum.InitAggregate;
|
||||
begin
|
||||
FResult.ResultType:=FArgumentNodes[0].NodeType;
|
||||
Case FResult.ResultType of
|
||||
rtFloat: FResult.ResFloat:=0.0;
|
||||
rtinteger: FResult.ResInteger:=0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TAggregateSum.UpdateAggregate;
|
||||
|
||||
Var
|
||||
R : TFPExpressionResult;
|
||||
|
||||
begin
|
||||
FArgumentNodes[0].GetNodeValue(R);
|
||||
Case FResult.ResultType of
|
||||
rtFloat: FResult.ResFloat:=FResult.ResFloat+R.ResFloat;
|
||||
rtinteger: FResult.ResInteger:=FResult.ResInteger+R.ResInteger;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TFPExpressionScanner
|
||||
---------------------------------------------------------------------}
|
||||
@ -1014,7 +1155,7 @@ end;
|
||||
TFPExpressionParser
|
||||
---------------------------------------------------------------------}
|
||||
|
||||
Function TFPExpressionParser.TokenType : TTokenType;
|
||||
function TFPExpressionParser.TokenType: TTokenType;
|
||||
|
||||
begin
|
||||
Result:=FScanner.TokenType;
|
||||
@ -1085,13 +1226,13 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Function TFPExpressionParser.GetToken : TTokenType;
|
||||
function TFPExpressionParser.GetToken: TTokenType;
|
||||
|
||||
begin
|
||||
Result:=FScanner.GetToken;
|
||||
end;
|
||||
|
||||
Procedure TFPExpressionParser.CheckEOF;
|
||||
procedure TFPExpressionParser.CheckEOF;
|
||||
|
||||
begin
|
||||
If (TokenType=ttEOF) then
|
||||
@ -1113,6 +1254,17 @@ begin
|
||||
FExprNode.GetNodeValue(Result);
|
||||
end;
|
||||
|
||||
function TFPExpressionParser.ExtractNode(Var N : TFPExprNode) : Boolean;
|
||||
begin
|
||||
Result:=Assigned(FExprNode);
|
||||
if Result then
|
||||
begin
|
||||
N:=FExprNode;
|
||||
FExprNode:=Nil;
|
||||
FExpression:='';
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPExpressionParser.ParserError(Msg: String);
|
||||
begin
|
||||
Raise EExprParser.Create(Msg);
|
||||
@ -1224,7 +1376,7 @@ end;
|
||||
if the result types differ, they are converted to a common type if possible.
|
||||
}
|
||||
|
||||
Procedure TFPExpressionParser.CheckNodes(Var Left,Right : TFPExprNode);
|
||||
procedure TFPExpressionParser.CheckNodes(var Left, Right: TFPExprNode);
|
||||
|
||||
begin
|
||||
Left:=MatchNodes(Left,Right);
|
||||
@ -1238,7 +1390,7 @@ begin
|
||||
FDirty:=True;
|
||||
end;
|
||||
|
||||
Function TFPExpressionParser.Level1 : TFPExprNode;
|
||||
function TFPExpressionParser.Level1: TFPExprNode;
|
||||
|
||||
var
|
||||
tt: TTokenType;
|
||||
@ -1458,7 +1610,7 @@ begin
|
||||
ACount:=3
|
||||
else if IfC then
|
||||
ACount:=-4
|
||||
else if (ID.IdentifierType in [itFunctionCallBack,itFunctionHandler]) then
|
||||
else if (ID.IdentifierType in [itFunctionCallBack,itFunctionHandler,itFunctionNode]) then
|
||||
ACount:=ID.ArgumentCount
|
||||
else
|
||||
ACount:=0;
|
||||
@ -1510,6 +1662,7 @@ begin
|
||||
itVariable : Result:= TFPExprVariable.CreateIdentifier(ID);
|
||||
itFunctionCallBack : Result:= TFPFunctionCallback.CreateFunction(ID,Args);
|
||||
itFunctionHandler : Result:= TFPFunctionEventHandler.CreateFunction(ID,Args);
|
||||
itFunctionNode : Result:= ID.NodeType.CreateFunction(ID,Args);
|
||||
end;
|
||||
end;
|
||||
GetToken;
|
||||
@ -1557,7 +1710,24 @@ function TFPExpressionParser.ResultType: TResultType;
|
||||
begin
|
||||
if not Assigned(FExprNode) then
|
||||
ParserError(SErrInExpression);
|
||||
Result:=FExprNode.NodeType;;
|
||||
Result:=FExprNode.NodeType;
|
||||
end;
|
||||
|
||||
function TFPExpressionParser.HasAggregate: Boolean;
|
||||
begin
|
||||
Result:=Assigned(FExprNode) and FExprNode.HasAggregate;
|
||||
end;
|
||||
|
||||
procedure TFPExpressionParser.InitAggregate;
|
||||
begin
|
||||
If Assigned(FExprNode) then
|
||||
FExprNode.InitAggregate;
|
||||
end;
|
||||
|
||||
procedure TFPExpressionParser.UpdateAggregate;
|
||||
begin
|
||||
If Assigned(FExprNode) then
|
||||
FExprNode.UpdateAggregate;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
@ -1717,6 +1887,18 @@ begin
|
||||
Result.FOnGetValue:=ACallBack;
|
||||
end;
|
||||
|
||||
function TFPExprIdentifierDefs.AddFunction(const AName: ShortString;
|
||||
const AResultType: Char; const AParamTypes: String;
|
||||
ANodeClass: TFPExprFunctionClass): TFPExprIdentifierDef;
|
||||
begin
|
||||
Result:=Add as TFPExprIdentifierDef;
|
||||
Result.Name:=Aname;
|
||||
Result.IdentifierType:=itFunctionNode;
|
||||
Result.ParameterTypes:=AParamTypes;
|
||||
Result.ResultType:=CharToResultType(AResultType);
|
||||
Result.FNodeType:=ANodeClass;
|
||||
end;
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
TFPExprIdentifierDef
|
||||
---------------------------------------------------------------------}
|
||||
@ -2042,6 +2224,14 @@ begin
|
||||
Result.Category:=ACategory;
|
||||
end;
|
||||
|
||||
function TExprBuiltInManager.AddFunction(const ACategory: TBuiltInCategory;
|
||||
const AName: ShortString; const AResultType: Char; const AParamTypes: String;
|
||||
ANodeClass: TFPExprFunctionClass): TFPBuiltInExprIdentifierDef;
|
||||
begin
|
||||
Result:=TFPBuiltInExprIdentifierDef(FDefs.AddFunction(AName,AResultType,AParamTypes,ANodeClass));
|
||||
Result. Category:=ACategory;
|
||||
end;
|
||||
|
||||
|
||||
{ ---------------------------------------------------------------------
|
||||
Various Nodes
|
||||
@ -2075,6 +2265,33 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPBinaryOperation.InitAggregate;
|
||||
begin
|
||||
inherited InitAggregate;
|
||||
if Assigned(Left) then
|
||||
Left.InitAggregate;
|
||||
if Assigned(Right) then
|
||||
Right.InitAggregate;
|
||||
end;
|
||||
|
||||
procedure TFPBinaryOperation.UpdateAggregate;
|
||||
begin
|
||||
inherited UpdateAggregate;
|
||||
if Assigned(Left) then
|
||||
Left.UpdateAggregate;
|
||||
if Assigned(Right) then
|
||||
Right.UpdateAggregate;
|
||||
end;
|
||||
|
||||
function TFPBinaryOperation.HasAggregate: Boolean;
|
||||
begin
|
||||
Result:=inherited HasAggregate;
|
||||
if Assigned(Left) then
|
||||
Result:=Result or Left.HasAggregate;
|
||||
if Assigned(Right) then
|
||||
Result:=Result or Right.HasAggregate;
|
||||
end;
|
||||
|
||||
procedure TFPBinaryOperation.Check;
|
||||
begin
|
||||
If Not Assigned(Left) then
|
||||
@ -2096,6 +2313,28 @@ begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TFPUnaryOperator.InitAggregate;
|
||||
begin
|
||||
inherited InitAggregate;
|
||||
if Assigned(FOperand) then
|
||||
FOperand.InitAggregate;
|
||||
|
||||
end;
|
||||
|
||||
procedure TFPUnaryOperator.UpdateAggregate;
|
||||
begin
|
||||
inherited UpdateAggregate;
|
||||
if Assigned(FOperand) then
|
||||
FOperand.UpdateAggregate;
|
||||
end;
|
||||
|
||||
function TFPUnaryOperator.HasAggregate: Boolean;
|
||||
begin
|
||||
Result:=inherited HasAggregate;
|
||||
if Assigned(FOperand) then
|
||||
Result:=Result or FOperand.HasAggregate;
|
||||
end;
|
||||
|
||||
procedure TFPUnaryOperator.Check;
|
||||
begin
|
||||
If Not Assigned(Operand) then
|
||||
@ -2249,6 +2488,26 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TFPExprNode.InitAggregate;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
procedure TFPExprNode.UpdateAggregate;
|
||||
begin
|
||||
// Do nothing
|
||||
end;
|
||||
|
||||
function TFPExprNode.HasAggregate: Boolean;
|
||||
begin
|
||||
Result:=IsAggregate;
|
||||
end;
|
||||
|
||||
class function TFPExprNode.IsAggregate: Boolean;
|
||||
begin
|
||||
Result:=False;
|
||||
end;
|
||||
|
||||
function TFPExprNode.NodeValue: TFPExpressionResult;
|
||||
begin
|
||||
GetNodeValue(Result);
|
||||
@ -2354,6 +2613,27 @@ begin
|
||||
CheckSameNodeTypes;
|
||||
end;
|
||||
|
||||
procedure TIfOperation.InitAggregate;
|
||||
begin
|
||||
inherited InitAggregate;
|
||||
If Assigned(FCondition) then
|
||||
fCondition.InitAggregate;
|
||||
end;
|
||||
|
||||
procedure TIfOperation.UpdateAggregate;
|
||||
begin
|
||||
inherited UpdateAggregate;
|
||||
If Assigned(FCondition) then
|
||||
FCondition.UpdateAggregate;
|
||||
end;
|
||||
|
||||
function TIfOperation.HasAggregate: Boolean;
|
||||
begin
|
||||
Result:=inherited HasAggregate;
|
||||
if Assigned(Condition) then
|
||||
Result:=Result or Condition.HasAggregate;
|
||||
end;
|
||||
|
||||
function TIfOperation.NodeType: TResultType;
|
||||
begin
|
||||
Result:=Left.NodeType;
|
||||
@ -2432,6 +2712,45 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCaseOperation.InitAggregate;
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
inherited InitAggregate;
|
||||
if Assigned(FCondition) then
|
||||
FCondition.InitAggregate;
|
||||
For I:=0 to Length(Fargs)-1 do
|
||||
FArgs[i].InitAggregate;
|
||||
end;
|
||||
|
||||
procedure TCaseOperation.UpdateAggregate;
|
||||
Var
|
||||
I : Integer;
|
||||
begin
|
||||
inherited UpdateAggregate;
|
||||
if Assigned(FCondition) then
|
||||
FCondition.UpdateAggregate;
|
||||
For I:=0 to Length(Fargs)-1 do
|
||||
FArgs[i].InitAggregate;
|
||||
end;
|
||||
|
||||
Function TCaseOperation.HasAggregate : Boolean;
|
||||
|
||||
Var
|
||||
I,L : Integer;
|
||||
begin
|
||||
Result:=inherited HasAggregate;
|
||||
L:=Length(Fargs);
|
||||
I:=0;
|
||||
While (Not Result) and (I<L) do
|
||||
begin
|
||||
Result:=Result or FArgs[i].HasAggregate;
|
||||
Inc(I)
|
||||
end;
|
||||
end;
|
||||
|
||||
function TCaseOperation.NodeType: TResultType;
|
||||
begin
|
||||
Result:=FArgs[1].NodeType;
|
||||
@ -2886,7 +3205,7 @@ begin
|
||||
// Automatically convert integers to floats in functions that return
|
||||
// a float
|
||||
if (rta = rtInteger) and (rtp = rtFloat) then begin
|
||||
FArgumentNodes[i] := TIntToFloatNode(FArgumentNodes[i]);
|
||||
FArgumentNodes[i] := TIntToFloatNode.Create(FArgumentNodes[i]);
|
||||
exit;
|
||||
end;
|
||||
|
||||
@ -3406,80 +3725,101 @@ begin
|
||||
Result.resDateTime:=Args[2].resDateTime
|
||||
end;
|
||||
|
||||
Procedure RegisterStdBuiltins(AManager : TExprBuiltInManager);
|
||||
procedure RegisterStdBuiltins(AManager: TExprBuiltInManager; Categories: TBuiltInCategories = AllBuiltIns);
|
||||
|
||||
begin
|
||||
With AManager do
|
||||
begin
|
||||
AddFloatVariable(bcMath,'pi',Pi);
|
||||
// Math functions
|
||||
AddFunction(bcMath,'cos','F','F',@BuiltinCos);
|
||||
AddFunction(bcMath,'sin','F','F',@BuiltinSin);
|
||||
AddFunction(bcMath,'arctan','F','F',@BuiltinArctan);
|
||||
AddFunction(bcMath,'abs','F','F',@BuiltinAbs);
|
||||
AddFunction(bcMath,'sqr','F','F',@BuiltinSqr);
|
||||
AddFunction(bcMath,'sqrt','F','F',@BuiltinSqrt);
|
||||
AddFunction(bcMath,'exp','F','F',@BuiltinExp);
|
||||
AddFunction(bcMath,'ln','F','F',@BuiltinLn);
|
||||
AddFunction(bcMath,'log','F','F',@BuiltinLog);
|
||||
AddFunction(bcMath,'frac','F','F',@BuiltinFrac);
|
||||
AddFunction(bcMath,'int','F','F',@BuiltinInt);
|
||||
AddFunction(bcMath,'round','I','F',@BuiltinRound);
|
||||
AddFunction(bcMath,'trunc','I','F',@BuiltinTrunc);
|
||||
// String
|
||||
AddFunction(bcStrings,'length','I','S',@BuiltinLength);
|
||||
AddFunction(bcStrings,'copy','S','SII',@BuiltinCopy);
|
||||
AddFunction(bcStrings,'delete','S','SII',@BuiltinDelete);
|
||||
AddFunction(bcStrings,'pos','I','SS',@BuiltinPos);
|
||||
AddFunction(bcStrings,'lowercase','S','S',@BuiltinLowercase);
|
||||
AddFunction(bcStrings,'uppercase','S','S',@BuiltinUppercase);
|
||||
AddFunction(bcStrings,'stringreplace','S','SSSBB',@BuiltinStringReplace);
|
||||
AddFunction(bcStrings,'comparetext','I','SS',@BuiltinCompareText);
|
||||
// Date/Time
|
||||
AddFunction(bcDateTime,'date','D','',@BuiltinDate);
|
||||
AddFunction(bcDateTime,'time','D','',@BuiltinTime);
|
||||
AddFunction(bcDateTime,'now','D','',@BuiltinNow);
|
||||
AddFunction(bcDateTime,'dayofweek','I','D',@BuiltinDayofweek);
|
||||
AddFunction(bcDateTime,'extractyear','I','D',@BuiltinExtractYear);
|
||||
AddFunction(bcDateTime,'extractmonth','I','D',@BuiltinExtractMonth);
|
||||
AddFunction(bcDateTime,'extractday','I','D',@BuiltinExtractDay);
|
||||
AddFunction(bcDateTime,'extracthour','I','D',@BuiltinExtractHour);
|
||||
AddFunction(bcDateTime,'extractmin','I','D',@BuiltinExtractMin);
|
||||
AddFunction(bcDateTime,'extractsec','I','D',@BuiltinExtractSec);
|
||||
AddFunction(bcDateTime,'extractmsec','I','D',@BuiltinExtractMSec);
|
||||
AddFunction(bcDateTime,'encodedate','D','III',@BuiltinEncodedate);
|
||||
AddFunction(bcDateTime,'encodetime','D','IIII',@BuiltinEncodeTime);
|
||||
AddFunction(bcDateTime,'encodedatetime','D','IIIIIII',@BuiltinEncodeDateTime);
|
||||
AddFunction(bcDateTime,'shortdayname','S','I',@BuiltinShortDayName);
|
||||
AddFunction(bcDateTime,'shortmonthname','S','I',@BuiltinShortMonthName);
|
||||
AddFunction(bcDateTime,'longdayname','S','I',@BuiltinLongDayName);
|
||||
AddFunction(bcDateTime,'longmonthname','S','I',@BuiltinLongMonthName);
|
||||
AddFunction(bcDateTime,'formatdatetime','S','SD',@BuiltinFormatDateTime);
|
||||
// Boolean
|
||||
AddFunction(bcBoolean,'shl','I','II',@BuiltinShl);
|
||||
AddFunction(bcBoolean,'shr','I','II',@BuiltinShr);
|
||||
AddFunction(bcBoolean,'IFS','S','BSS',@BuiltinIFS);
|
||||
AddFunction(bcBoolean,'IFF','F','BFF',@BuiltinIFF);
|
||||
AddFunction(bcBoolean,'IFD','D','BDD',@BuiltinIFD);
|
||||
AddFunction(bcBoolean,'IFI','I','BII',@BuiltinIFI);
|
||||
// Conversion
|
||||
AddFunction(bcConversion,'inttostr','S','I',@BuiltInIntToStr);
|
||||
AddFunction(bcConversion,'strtoint','I','S',@BuiltInStrToInt);
|
||||
AddFunction(bcConversion,'strtointdef','I','SI',@BuiltInStrToIntDef);
|
||||
AddFunction(bcConversion,'floattostr','S','F',@BuiltInFloatToStr);
|
||||
AddFunction(bcConversion,'strtofloat','F','S',@BuiltInStrToFloat);
|
||||
AddFunction(bcConversion,'strtofloatdef','F','SF',@BuiltInStrToFloatDef);
|
||||
AddFunction(bcConversion,'booltostr','S','B',@BuiltInBoolToStr);
|
||||
AddFunction(bcConversion,'strtobool','B','S',@BuiltInStrToBool);
|
||||
AddFunction(bcConversion,'strtobooldef','B','SB',@BuiltInStrToBoolDef);
|
||||
AddFunction(bcConversion,'datetostr','S','D',@BuiltInDateToStr);
|
||||
AddFunction(bcConversion,'timetostr','S','D',@BuiltInTimeToStr);
|
||||
AddFunction(bcConversion,'strtodate','D','S',@BuiltInStrToDate);
|
||||
AddFunction(bcConversion,'strtodatedef','D','SD',@BuiltInStrToDateDef);
|
||||
AddFunction(bcConversion,'strtotime','D','S',@BuiltInStrToTime);
|
||||
AddFunction(bcConversion,'strtotimedef','D','SD',@BuiltInStrToTimeDef);
|
||||
AddFunction(bcConversion,'strtodatetime','D','S',@BuiltInStrToDateTime);
|
||||
AddFunction(bcConversion,'strtodatetimedef','D','SD',@BuiltInStrToDateTimeDef);
|
||||
if bcMath in Categories then
|
||||
begin
|
||||
AddFloatVariable(bcMath,'pi',Pi);
|
||||
// Math functions
|
||||
AddFunction(bcMath,'cos','F','F',@BuiltinCos);
|
||||
AddFunction(bcMath,'sin','F','F',@BuiltinSin);
|
||||
AddFunction(bcMath,'arctan','F','F',@BuiltinArctan);
|
||||
AddFunction(bcMath,'abs','F','F',@BuiltinAbs);
|
||||
AddFunction(bcMath,'sqr','F','F',@BuiltinSqr);
|
||||
AddFunction(bcMath,'sqrt','F','F',@BuiltinSqrt);
|
||||
AddFunction(bcMath,'exp','F','F',@BuiltinExp);
|
||||
AddFunction(bcMath,'ln','F','F',@BuiltinLn);
|
||||
AddFunction(bcMath,'log','F','F',@BuiltinLog);
|
||||
AddFunction(bcMath,'frac','F','F',@BuiltinFrac);
|
||||
AddFunction(bcMath,'int','F','F',@BuiltinInt);
|
||||
AddFunction(bcMath,'round','I','F',@BuiltinRound);
|
||||
AddFunction(bcMath,'trunc','I','F',@BuiltinTrunc);
|
||||
end;
|
||||
if bcStrings in Categories then
|
||||
begin
|
||||
// String
|
||||
AddFunction(bcStrings,'length','I','S',@BuiltinLength);
|
||||
AddFunction(bcStrings,'copy','S','SII',@BuiltinCopy);
|
||||
AddFunction(bcStrings,'delete','S','SII',@BuiltinDelete);
|
||||
AddFunction(bcStrings,'pos','I','SS',@BuiltinPos);
|
||||
AddFunction(bcStrings,'lowercase','S','S',@BuiltinLowercase);
|
||||
AddFunction(bcStrings,'uppercase','S','S',@BuiltinUppercase);
|
||||
AddFunction(bcStrings,'stringreplace','S','SSSBB',@BuiltinStringReplace);
|
||||
AddFunction(bcStrings,'comparetext','I','SS',@BuiltinCompareText);
|
||||
end;
|
||||
if bcDateTime in Categories then
|
||||
begin
|
||||
// Date/Time
|
||||
AddFunction(bcDateTime,'date','D','',@BuiltinDate);
|
||||
AddFunction(bcDateTime,'time','D','',@BuiltinTime);
|
||||
AddFunction(bcDateTime,'now','D','',@BuiltinNow);
|
||||
AddFunction(bcDateTime,'dayofweek','I','D',@BuiltinDayofweek);
|
||||
AddFunction(bcDateTime,'extractyear','I','D',@BuiltinExtractYear);
|
||||
AddFunction(bcDateTime,'extractmonth','I','D',@BuiltinExtractMonth);
|
||||
AddFunction(bcDateTime,'extractday','I','D',@BuiltinExtractDay);
|
||||
AddFunction(bcDateTime,'extracthour','I','D',@BuiltinExtractHour);
|
||||
AddFunction(bcDateTime,'extractmin','I','D',@BuiltinExtractMin);
|
||||
AddFunction(bcDateTime,'extractsec','I','D',@BuiltinExtractSec);
|
||||
AddFunction(bcDateTime,'extractmsec','I','D',@BuiltinExtractMSec);
|
||||
AddFunction(bcDateTime,'encodedate','D','III',@BuiltinEncodedate);
|
||||
AddFunction(bcDateTime,'encodetime','D','IIII',@BuiltinEncodeTime);
|
||||
AddFunction(bcDateTime,'encodedatetime','D','IIIIIII',@BuiltinEncodeDateTime);
|
||||
AddFunction(bcDateTime,'shortdayname','S','I',@BuiltinShortDayName);
|
||||
AddFunction(bcDateTime,'shortmonthname','S','I',@BuiltinShortMonthName);
|
||||
AddFunction(bcDateTime,'longdayname','S','I',@BuiltinLongDayName);
|
||||
AddFunction(bcDateTime,'longmonthname','S','I',@BuiltinLongMonthName);
|
||||
AddFunction(bcDateTime,'formatdatetime','S','SD',@BuiltinFormatDateTime);
|
||||
end;
|
||||
if bcBoolean in Categories then
|
||||
begin
|
||||
// Boolean
|
||||
AddFunction(bcBoolean,'shl','I','II',@BuiltinShl);
|
||||
AddFunction(bcBoolean,'shr','I','II',@BuiltinShr);
|
||||
AddFunction(bcBoolean,'IFS','S','BSS',@BuiltinIFS);
|
||||
AddFunction(bcBoolean,'IFF','F','BFF',@BuiltinIFF);
|
||||
AddFunction(bcBoolean,'IFD','D','BDD',@BuiltinIFD);
|
||||
AddFunction(bcBoolean,'IFI','I','BII',@BuiltinIFI);
|
||||
end;
|
||||
if (bcConversion in Categories) then
|
||||
begin
|
||||
// Conversion
|
||||
AddFunction(bcConversion,'inttostr','S','I',@BuiltInIntToStr);
|
||||
AddFunction(bcConversion,'strtoint','I','S',@BuiltInStrToInt);
|
||||
AddFunction(bcConversion,'strtointdef','I','SI',@BuiltInStrToIntDef);
|
||||
AddFunction(bcConversion,'floattostr','S','F',@BuiltInFloatToStr);
|
||||
AddFunction(bcConversion,'strtofloat','F','S',@BuiltInStrToFloat);
|
||||
AddFunction(bcConversion,'strtofloatdef','F','SF',@BuiltInStrToFloatDef);
|
||||
AddFunction(bcConversion,'booltostr','S','B',@BuiltInBoolToStr);
|
||||
AddFunction(bcConversion,'strtobool','B','S',@BuiltInStrToBool);
|
||||
AddFunction(bcConversion,'strtobooldef','B','SB',@BuiltInStrToBoolDef);
|
||||
AddFunction(bcConversion,'datetostr','S','D',@BuiltInDateToStr);
|
||||
AddFunction(bcConversion,'timetostr','S','D',@BuiltInTimeToStr);
|
||||
AddFunction(bcConversion,'strtodate','D','S',@BuiltInStrToDate);
|
||||
AddFunction(bcConversion,'strtodatedef','D','SD',@BuiltInStrToDateDef);
|
||||
AddFunction(bcConversion,'strtotime','D','S',@BuiltInStrToTime);
|
||||
AddFunction(bcConversion,'strtotimedef','D','SD',@BuiltInStrToTimeDef);
|
||||
AddFunction(bcConversion,'strtodatetime','D','S',@BuiltInStrToDateTime);
|
||||
AddFunction(bcConversion,'strtodatetimedef','D','SD',@BuiltInStrToDateTimeDef);
|
||||
end;
|
||||
if bcAggregate in Categories then
|
||||
begin
|
||||
AddFunction(bcAggregate,'count','I','',TAggregateCount);
|
||||
AddFunction(bcAggregate,'sum','F','F',TAggregateSum);
|
||||
AddFunction(bcAggregate,'avg','F','F',TAggregateAvg);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -792,6 +792,45 @@ type
|
||||
procedure TestFunction29;
|
||||
end;
|
||||
|
||||
{ TAggregateNode }
|
||||
|
||||
TAggregateNode = Class(TFPExprNode)
|
||||
Public
|
||||
InitCount : Integer;
|
||||
UpdateCount : Integer;
|
||||
Class Function IsAggregate: Boolean; override;
|
||||
Function NodeType: TResultType; override;
|
||||
Procedure InitAggregate; override;
|
||||
Procedure UpdateAggregate; override;
|
||||
procedure GetNodeValue(var Result: TFPExpressionResult); override;
|
||||
end;
|
||||
|
||||
{ TTestParserAggregate }
|
||||
|
||||
TTestParserAggregate = Class(TTestExpressionParser)
|
||||
private
|
||||
FVarValue : Integer;
|
||||
FLeft : TAggregateNode;
|
||||
FRight : TAggregateNode;
|
||||
FFunction : TFPExprIdentifierDef;
|
||||
FFunction2 : TFPExprIdentifierDef;
|
||||
Protected
|
||||
Procedure Setup; override;
|
||||
Procedure TearDown; override;
|
||||
public
|
||||
procedure GetVar(var Result: TFPExpressionResult; ConstRef AName: ShortString);
|
||||
Published
|
||||
Procedure TestIsAggregate;
|
||||
Procedure TestHasAggregate;
|
||||
Procedure TestBinaryAggregate;
|
||||
Procedure TestUnaryAggregate;
|
||||
Procedure TestCountAggregate;
|
||||
Procedure TestSumAggregate;
|
||||
Procedure TestSumAggregate2;
|
||||
Procedure TestAvgAggregate;
|
||||
Procedure TestAvgAggregate2;
|
||||
Procedure TestAvgAggregate3;
|
||||
end;
|
||||
{ TTestBuiltinsManager }
|
||||
|
||||
TTestBuiltinsManager = Class(TTestExpressionParser)
|
||||
@ -814,8 +853,10 @@ type
|
||||
|
||||
TTestBuiltins = Class(TTestExpressionParser)
|
||||
private
|
||||
FValue : Integer;
|
||||
FM : TExprBuiltInManager;
|
||||
FExpr : String;
|
||||
procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
|
||||
Protected
|
||||
procedure Setup; override;
|
||||
procedure Teardown; override;
|
||||
@ -827,6 +868,8 @@ type
|
||||
procedure AssertExpression(Const AExpression : String; Const AResult : TExprFloat);
|
||||
procedure AssertExpression(Const AExpression : String; Const AResult : Boolean);
|
||||
procedure AssertDateTimeExpression(Const AExpression : String; Const AResult : TDateTime);
|
||||
procedure AssertAggregateExpression(Const AExpression : String; AResult : Int64; AUpdateCount : integer);
|
||||
procedure AssertAggregateExpression(Const AExpression : String; AResult : TExprFloat; AUpdateCount : integer);
|
||||
Published
|
||||
procedure TestRegister;
|
||||
Procedure TestVariablepi;
|
||||
@ -893,12 +936,335 @@ type
|
||||
Procedure TestFunctionstrtotimedef;
|
||||
Procedure TestFunctionstrtodatetime;
|
||||
Procedure TestFunctionstrtodatetimedef;
|
||||
Procedure TestFunctionAggregateSum;
|
||||
Procedure TestFunctionAggregateCount;
|
||||
Procedure TestFunctionAggregateAvg;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses typinfo;
|
||||
|
||||
{ TTestParserAggregate }
|
||||
|
||||
procedure TTestParserAggregate.Setup;
|
||||
begin
|
||||
inherited Setup;
|
||||
FVarValue:=0;
|
||||
FFunction:=TFPExprIdentifierDef.Create(Nil);
|
||||
FFunction.Name:='Count';
|
||||
FFunction2:=TFPExprIdentifierDef.Create(Nil);
|
||||
FFunction2.Name:='MyVar';
|
||||
FFunction2.ResultType:=rtInteger;
|
||||
FFunction2.IdentifierType:=itVariable;
|
||||
FFunction2.OnGetVariableValue:=@GetVar;
|
||||
FLeft:=TAggregateNode.Create;
|
||||
FRight:=TAggregateNode.Create;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TearDown;
|
||||
begin
|
||||
FreeAndNil(FFunction);
|
||||
FreeAndNil(FLeft);
|
||||
FreeAndNil(FRight);
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.GetVar(var Result: TFPExpressionResult; ConstRef
|
||||
AName: ShortString);
|
||||
begin
|
||||
Result.ResultType:=FFunction2.ResultType;
|
||||
Case Result.ResultType of
|
||||
rtInteger : Result.ResInteger:=FVarValue;
|
||||
rtFloat : Result.ResFloat:=FVarValue / 2;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestIsAggregate;
|
||||
begin
|
||||
AssertEquals('ExprNode',False,TFPExprNode.IsAggregate);
|
||||
AssertEquals('TAggregateExpr',True,TAggregateExpr.IsAggregate);
|
||||
AssertEquals('TAggregateExpr',False,TFPBinaryOperation.IsAggregate);
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestHasAggregate;
|
||||
|
||||
Var
|
||||
N : TFPExprNode;
|
||||
|
||||
begin
|
||||
N:=TFPExprNode.Create;
|
||||
try
|
||||
AssertEquals('ExprNode',False,N.HasAggregate);
|
||||
finally
|
||||
N.Free;
|
||||
end;
|
||||
N:=TAggregateExpr.Create;
|
||||
try
|
||||
AssertEquals('ExprNode',True,N.HasAggregate);
|
||||
finally
|
||||
N.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestBinaryAggregate;
|
||||
|
||||
Var
|
||||
B : TFPBinaryOperation;
|
||||
|
||||
begin
|
||||
B:=TFPBinaryOperation.Create(Fleft,TFPConstExpression.CreateInteger(1));
|
||||
try
|
||||
FLeft:=Nil;
|
||||
AssertEquals('Binary',True,B.HasAggregate);
|
||||
finally
|
||||
B.Free;
|
||||
end;
|
||||
B:=TFPBinaryOperation.Create(TFPConstExpression.CreateInteger(1),FRight);
|
||||
try
|
||||
FRight:=Nil;
|
||||
AssertEquals('Binary',True,B.HasAggregate);
|
||||
finally
|
||||
B.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestUnaryAggregate;
|
||||
Var
|
||||
B : TFPUnaryOperator;
|
||||
|
||||
begin
|
||||
B:=TFPUnaryOperator.Create(Fleft);
|
||||
try
|
||||
FLeft:=Nil;
|
||||
AssertEquals('Unary',True,B.HasAggregate);
|
||||
finally
|
||||
B.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestCountAggregate;
|
||||
|
||||
Var
|
||||
C : TAggregateCount;
|
||||
I : Integer;
|
||||
R : TFPExpressionResult;
|
||||
|
||||
begin
|
||||
FFunction.ResultType:=rtInteger;
|
||||
FFunction.ParameterTypes:='';
|
||||
C:=TAggregateCount.CreateFunction(FFunction,Nil);
|
||||
try
|
||||
C.Check;
|
||||
C.InitAggregate;
|
||||
For I:=1 to 11 do
|
||||
C.UpdateAggregate;
|
||||
C.GetNodeValue(R);
|
||||
AssertEquals('Correct type',rtInteger,R.ResultType);
|
||||
AssertEquals('Correct value',11,R.ResInteger);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestSumAggregate;
|
||||
|
||||
Var
|
||||
C : TAggregateSum;
|
||||
V : TFPExprVariable;
|
||||
I : Integer;
|
||||
R : TFPExpressionResult;
|
||||
A : TExprArgumentArray;
|
||||
|
||||
begin
|
||||
FFunction.ResultType:=rtInteger;
|
||||
FFunction.ParameterTypes:='I';
|
||||
FFunction.Name:='SUM';
|
||||
FFunction2.ResultType:=rtInteger;
|
||||
C:=Nil;
|
||||
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||
try
|
||||
SetLength(A,1);
|
||||
A[0]:=V;
|
||||
C:=TAggregateSum.CreateFunction(FFunction,A);
|
||||
C.Check;
|
||||
C.InitAggregate;
|
||||
For I:=1 to 10 do
|
||||
begin
|
||||
FVarValue:=I;
|
||||
C.UpdateAggregate;
|
||||
end;
|
||||
C.GetNodeValue(R);
|
||||
AssertEquals('Correct type',rtInteger,R.ResultType);
|
||||
AssertEquals('Correct value',55,R.ResInteger);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestSumAggregate2;
|
||||
Var
|
||||
C : TAggregateSum;
|
||||
V : TFPExprVariable;
|
||||
I : Integer;
|
||||
R : TFPExpressionResult;
|
||||
A : TExprArgumentArray;
|
||||
|
||||
begin
|
||||
FFunction.ResultType:=rtFloat;
|
||||
FFunction.ParameterTypes:='F';
|
||||
FFunction.Name:='SUM';
|
||||
FFunction2.ResultType:=rtFloat;
|
||||
C:=Nil;
|
||||
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||
try
|
||||
SetLength(A,1);
|
||||
A[0]:=V;
|
||||
C:=TAggregateSum.CreateFunction(FFunction,A);
|
||||
C.Check;
|
||||
C.InitAggregate;
|
||||
For I:=1 to 10 do
|
||||
begin
|
||||
FVarValue:=I;
|
||||
C.UpdateAggregate;
|
||||
end;
|
||||
C.GetNodeValue(R);
|
||||
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||
AssertEquals('Correct value',55/2,R.ResFloat,0.1);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestAvgAggregate;
|
||||
|
||||
Var
|
||||
C : TAggregateAvg;
|
||||
V : TFPExprVariable;
|
||||
I : Integer;
|
||||
R : TFPExpressionResult;
|
||||
A : TExprArgumentArray;
|
||||
|
||||
begin
|
||||
FFunction.ResultType:=rtInteger;
|
||||
FFunction.ParameterTypes:='F';
|
||||
FFunction.Name:='AVG';
|
||||
FFunction2.ResultType:=rtInteger;
|
||||
C:=Nil;
|
||||
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||
try
|
||||
SetLength(A,1);
|
||||
A[0]:=V;
|
||||
C:=TAggregateAvg.CreateFunction(FFunction,A);
|
||||
C.Check;
|
||||
C.InitAggregate;
|
||||
For I:=1 to 10 do
|
||||
begin
|
||||
FVarValue:=I;
|
||||
C.UpdateAggregate;
|
||||
end;
|
||||
C.GetNodeValue(R);
|
||||
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||
AssertEquals('Correct value',5.5,R.ResFloat,0.1);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestAvgAggregate2;
|
||||
|
||||
Var
|
||||
C : TAggregateAvg;
|
||||
V : TFPExprVariable;
|
||||
I : Integer;
|
||||
R : TFPExpressionResult;
|
||||
A : TExprArgumentArray;
|
||||
|
||||
begin
|
||||
FFunction.ResultType:=rtInteger;
|
||||
FFunction.ParameterTypes:='F';
|
||||
FFunction.Name:='AVG';
|
||||
FFunction2.ResultType:=rtFloat;
|
||||
C:=Nil;
|
||||
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||
try
|
||||
SetLength(A,1);
|
||||
A[0]:=V;
|
||||
C:=TAggregateAvg.CreateFunction(FFunction,A);
|
||||
C.Check;
|
||||
C.InitAggregate;
|
||||
For I:=1 to 10 do
|
||||
begin
|
||||
FVarValue:=I;
|
||||
C.UpdateAggregate;
|
||||
end;
|
||||
C.GetNodeValue(R);
|
||||
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||
AssertEquals('Correct value',5.5/2,R.ResFloat,0.1);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TTestParserAggregate.TestAvgAggregate3;
|
||||
Var
|
||||
C : TAggregateAvg;
|
||||
V : TFPExprVariable;
|
||||
I : Integer;
|
||||
R : TFPExpressionResult;
|
||||
A : TExprArgumentArray;
|
||||
|
||||
begin
|
||||
FFunction.ResultType:=rtInteger;
|
||||
FFunction.ParameterTypes:='F';
|
||||
FFunction.Name:='AVG';
|
||||
FFunction2.ResultType:=rtFloat;
|
||||
C:=Nil;
|
||||
V:=TFPExprVariable.CreateIdentifier(FFunction2);
|
||||
try
|
||||
SetLength(A,1);
|
||||
A[0]:=V;
|
||||
C:=TAggregateAvg.CreateFunction(FFunction,A);
|
||||
C.Check;
|
||||
C.InitAggregate;
|
||||
C.GetNodeValue(R);
|
||||
AssertEquals('Correct type',rtFloat,R.ResultType);
|
||||
AssertEquals('Correct value',0.0,R.ResFloat,0.1);
|
||||
finally
|
||||
C.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TAggregateNode }
|
||||
|
||||
class function TAggregateNode.IsAggregate: Boolean;
|
||||
begin
|
||||
Result:=True
|
||||
end;
|
||||
|
||||
function TAggregateNode.NodeType: TResultType;
|
||||
begin
|
||||
Result:=rtInteger;
|
||||
end;
|
||||
|
||||
procedure TAggregateNode.InitAggregate;
|
||||
begin
|
||||
inherited InitAggregate;
|
||||
inc(InitCount)
|
||||
end;
|
||||
|
||||
procedure TAggregateNode.UpdateAggregate;
|
||||
begin
|
||||
inherited UpdateAggregate;
|
||||
inc(UpdateCount);
|
||||
end;
|
||||
|
||||
procedure TAggregateNode.GetNodeValue(var Result: TFPExpressionResult);
|
||||
begin
|
||||
Result.ResultType:=rtInteger;
|
||||
Result.ResInteger:=updateCount;
|
||||
end;
|
||||
|
||||
procedure TTestExpressionScanner.TestCreate;
|
||||
begin
|
||||
AssertEquals('Empty source','',FP.Source);
|
||||
@ -5055,6 +5421,7 @@ procedure TTestBuiltins.Setup;
|
||||
begin
|
||||
inherited Setup;
|
||||
FM:=TExprBuiltInManager.Create(Nil);
|
||||
FValue:=0;
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.Teardown;
|
||||
@ -5063,7 +5430,7 @@ begin
|
||||
inherited Teardown;
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.SetExpression(Const AExpression : String);
|
||||
procedure TTestBuiltins.SetExpression(const AExpression: String);
|
||||
|
||||
Var
|
||||
Msg : String;
|
||||
@ -5148,11 +5515,41 @@ begin
|
||||
AssertDatetimeResult(AResult);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
|
||||
AResult: Int64; AUpdateCount: integer);
|
||||
begin
|
||||
FP.BuiltIns:=AllBuiltIns;
|
||||
SetExpression(AExpression);
|
||||
AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
|
||||
FP.InitAggregate;
|
||||
While AUpdateCount>0 do
|
||||
begin
|
||||
FP.UpdateAggregate;
|
||||
Dec(AUpdateCount);
|
||||
end;
|
||||
AssertResult(AResult);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.AssertAggregateExpression(const AExpression: String;
|
||||
AResult: TExprFloat; AUpdateCount: integer);
|
||||
begin
|
||||
FP.BuiltIns:=AllBuiltIns;
|
||||
SetExpression(AExpression);
|
||||
AssertEquals('Has aggregate',True,FP.ExprNode.HasAggregate);
|
||||
FP.InitAggregate;
|
||||
While AUpdateCount>0 do
|
||||
begin
|
||||
FP.UpdateAggregate;
|
||||
Dec(AUpdateCount);
|
||||
end;
|
||||
AssertResult(AResult);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.TestRegister;
|
||||
|
||||
begin
|
||||
RegisterStdBuiltins(FM);
|
||||
AssertEquals('Correct number of identifiers',64,FM.IdentifierCount);
|
||||
AssertEquals('Correct number of identifiers',67,FM.IdentifierCount);
|
||||
Assertvariable('pi',rtFloat);
|
||||
AssertFunction('cos','F','F',bcMath);
|
||||
AssertFunction('sin','F','F',bcMath);
|
||||
@ -5217,6 +5614,9 @@ begin
|
||||
AssertFunction('strtotimedef','D','SD',bcConversion);
|
||||
AssertFunction('strtodatetime','D','S',bcConversion);
|
||||
AssertFunction('strtodatetimedef','D','SD',bcConversion);
|
||||
AssertFunction('sum','F','F',bcAggregate);
|
||||
AssertFunction('count','I','',bcAggregate);
|
||||
AssertFunction('avg','F','F',bcAggregate);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.TestVariablepi;
|
||||
@ -5667,6 +6067,33 @@ begin
|
||||
AssertExpression('StrToDateTimeDef('''+S+''',S)',T);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.TestFunctionAggregateSum;
|
||||
begin
|
||||
FP.Identifiers.AddIntegerVariable('S',2);
|
||||
AssertAggregateExpression('sum(S)',10.0,5);
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.TestFunctionAggregateCount;
|
||||
begin
|
||||
AssertAggregateExpression('count',5,5);
|
||||
end;
|
||||
|
||||
|
||||
procedure TTestBuiltins.DoAverage(var Result: TFPExpressionResult; ConstRef
|
||||
AName: ShortString);
|
||||
|
||||
begin
|
||||
Inc(FValue);
|
||||
Result.ResInteger:=FValue;
|
||||
Result.ResultType:=rtInteger;
|
||||
end;
|
||||
|
||||
procedure TTestBuiltins.TestFunctionAggregateAvg;
|
||||
begin
|
||||
FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
|
||||
AssertAggregateExpression('avg(S)',5.5,10);
|
||||
end;
|
||||
|
||||
{ TTestNotNode }
|
||||
|
||||
procedure TTestNotNode.TearDown;
|
||||
@ -6113,6 +6540,7 @@ initialization
|
||||
TTestParserExpressions, TTestParserBooleanOperations,
|
||||
TTestParserOperands, TTestParserTypeMatch,
|
||||
TTestParserVariables,TTestParserFunctions,
|
||||
TTestParserAggregate,
|
||||
TTestBuiltinsManager,TTestBuiltins]);
|
||||
end.
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user