paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 10:10:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Min/Max aggregates

Browse Source 
git-svn-id: trunk@34422 -
This commit is contained in:
michael 2016-09-04 06:07:34 +00:00
parent 54ac4c91c8
commit 394ec97d80
2 changed files with 141 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

119
packages/fcl-base/src/fpexprpars.pp
View File

@ -571,6 +571,26 @@ Type
Procedure GetNodeValue(var Result : TFPExpressionResult); override;
end;
{ TAggregateMin }
TAggregateMin = Class(TAggregateExpr)
Public
FFirst: Boolean;
Public
Procedure InitAggregate; override;
Procedure UpdateAggregate; override;
end;
{ TAggregateMax }
TAggregateMax = Class(TAggregateExpr)
Public
FFirst: Boolean;
Public
Procedure InitAggregate; override;
Procedure UpdateAggregate; override;
end;
{ TAggregateSum }
TAggregateSum = Class(TAggregateExpr)
@ -841,6 +861,78 @@ begin
FreeAndNil(Builtins);
end;
{ TAggregateMax }
procedure TAggregateMax.InitAggregate;
begin
inherited InitAggregate;
FFirst:=True;
FResult.ResultType:=rtFloat;
FResult.resFloat:=0;
end;
procedure TAggregateMax.UpdateAggregate;
Var
OK : Boolean;
N : TFPExpressionResult;
begin
FArgumentNodes[0].GetNodeValue(N);
if FFirst then
begin
FFirst:=False;
OK:=True;
end
else
Case N.ResultType of
rtFloat: OK:=N.ResFloat>FResult.ResFloat;
rtinteger: OK:=N.ResInteger>FResult.ResFloat;
end;
if OK then
Case N.ResultType of
rtFloat: FResult.ResFloat:=N.ResFloat;
rtinteger: FResult.ResFloat:=N.ResInteger;
end;
end;
{ TAggregateMin }
procedure TAggregateMin.InitAggregate;
begin
inherited InitAggregate;
FFirst:=True;
FResult.ResultType:=rtFloat;
FResult.resFloat:=0;
end;
procedure TAggregateMin.UpdateAggregate;
Var
OK : Boolean;
N : TFPExpressionResult;
begin
FArgumentNodes[0].GetNodeValue(N);
if FFirst then
begin
FResult.ResultType:=N.ResultType;
FFirst:=False;
OK:=True;
end
else
Case N.ResultType of
rtFloat: OK:=N.ResFloat<FResult.ResFloat;
rtinteger: OK:=N.ResInteger<FResult.ResFloat;
end;
if OK then
Case FResult.ResultType of
rtFloat: FResult.ResFloat:=N.ResFloat;
rtinteger: FResult.ResFloat:=N.ResInteger;
end;
inherited UpdateAggregate;
end;
{ TAggregateAvg }
procedure TAggregateAvg.InitAggregate;
@ -2050,6 +2142,7 @@ procedure TFPExprIdentifierDef.FetchValue;
Var
RT,RT2 : TResultType;
I : Integer;
begin
RT:=FValue.ResultType;
@ -2060,13 +2153,23 @@ begin
RT2:=FValue.ResultType;
if RT2<>RT then
begin
// Restore
FValue.ResultType:=RT;
Raise EExprParser.CreateFmt('Value handler for variable %s returned wrong type, expected "%s", got "%s"',[
FName,
GetEnumName(TypeInfo(TResultType),Ord(rt)),
GetEnumName(TypeInfo(TResultType),Ord(rt2))
]);
// Automatically convert integer to float.
if (rt2=rtInteger) and (rt=rtFLoat) then
begin
FValue.ResultType:=RT;
I:=FValue.resInteger;
FValue.resFloat:=I;
end
else
begin
// Restore
FValue.ResultType:=RT;
Raise EExprParser.CreateFmt('Value handler for variable %s returned wrong type, expected "%s", got "%s"',[
FName,
GetEnumName(TypeInfo(TResultType),Ord(rt)),
GetEnumName(TypeInfo(TResultType),Ord(rt2))
]);
end;
end;
end;
@ -3819,6 +3922,8 @@ begin
AddFunction(bcAggregate,'count','I','',TAggregateCount);
AddFunction(bcAggregate,'sum','F','F',TAggregateSum);
AddFunction(bcAggregate,'avg','F','F',TAggregateAvg);
AddFunction(bcAggregate,'min','F','F',TAggregateMin);
AddFunction(bcAggregate,'max','F','F',TAggregateMax);
end;
end;
end;

29
packages/fcl-base/tests/testexprpars.pp
View File

@ -857,6 +857,7 @@ type
FM : TExprBuiltInManager;
FExpr : String;
procedure DoAverage(Var Result : TFPExpressionResult; ConstRef AName : ShortString);
procedure DoSeries(var Result: TFPExpressionResult; ConstRef AName: ShortString);
Protected
procedure Setup; override;
procedure Teardown; override;
@ -939,6 +940,8 @@ type
Procedure TestFunctionAggregateSum;
Procedure TestFunctionAggregateCount;
Procedure TestFunctionAggregateAvg;
Procedure TestFunctionAggregateMin;
Procedure TestFunctionAggregateMax;
end;
implementation
@ -6088,12 +6091,38 @@ begin
Result.ResultType:=rtInteger;
end;
procedure TTestBuiltins.DoSeries(var Result: TFPExpressionResult; ConstRef
AName: ShortString);
Const
Values : Array[1..10] of double =
(1.3,1.8,1.1,9.9,1.4,2.4,5.8,6.5,7.8,8.1);
begin
Inc(FValue);
Result.ResFloat:=Values[FValue];
Result.ResultType:=rtFloat;
end;
procedure TTestBuiltins.TestFunctionAggregateAvg;
begin
FP.Identifiers.AddVariable('S',rtInteger,@DoAverage);
AssertAggregateExpression('avg(S)',5.5,10);
end;
procedure TTestBuiltins.TestFunctionAggregateMin;
begin
FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
AssertAggregateExpression('Min(S)',1.1,10);
end;
procedure TTestBuiltins.TestFunctionAggregateMax;
begin
FP.Identifiers.AddVariable('S',rtFloat,@DoSeries);
AssertAggregateExpression('Max(S)',9.9,10);
end;
{ TTestNotNode }
procedure TTestNotNode.TearDown;