* Added possibility for array arguments

git-svn-id: trunk@43637 -

packages/fcl-base/src/fpexprpars.pp

@@ -499,6 +499,7 @@ Type
     FArgumentTypes: String;
     FIDType: TIdentifierType;
     FName: ShortString;
+    FVariableArgumentCount: Boolean;
     FOnGetValue: TFPExprFunctionEvent;
     FOnGetValueCB: TFPExprFunctionCallBack;
     function GetAsBoolean: Boolean;
@@ -544,6 +545,7 @@ Type
     Property OnGetFunctionValue : TFPExprFunctionEvent Read FOnGetValue Write FOnGetValue;
     Property OnGetVariableValue : TFPExprVariableEvent Read FOnGetVarValue Write FOnGetVarValue;
     Property NodeType : TFPExprFunctionClass Read FNodeType Write FNodeType;
+    property VariableArgumentCount: Boolean read FVariableArgumentCount write FVariableArgumentCount;
   end;
 
 
@@ -2272,7 +2274,11 @@ begin
   Result:=Add as TFPExprIdentifierDef;
   Result.Name:=Aname;
   Result.IdentifierType:=itFunctionCallBack;
-  Result.ParameterTypes:=AParamTypes;
+  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
+    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
+    Result.FVariableArgumentCount := true;
+  end else
+    Result.ParameterTypes := AParamTypes;
   Result.ResultType:=CharToResultType(AResultType);
   Result.FOnGetValueCB:=ACallBack;
 end;
@@ -2284,7 +2290,11 @@ begin
   Result:=Add as TFPExprIdentifierDef;
   Result.Name:=Aname;
   Result.IdentifierType:=itFunctionHandler;
-  Result.ParameterTypes:=AParamTypes;
+  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
+    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
+    Result.FVariableArgumentCount := true;
+  end else
+    Result.ParameterTypes := AParamTypes;
   Result.ResultType:=CharToResultType(AResultType);
   Result.FOnGetValue:=ACallBack;
 end;
@@ -2296,7 +2306,11 @@ begin
   Result:=Add as TFPExprIdentifierDef;
   Result.Name:=Aname;
   Result.IdentifierType:=itFunctionNode;
-  Result.ParameterTypes:=AParamTypes;
+  if (AParamTypes <> '') and (AParamTypes[Length(AParamTypes)] = '+') then begin
+    Result.ParameterTypes := Copy(AParamTypes, 1, Length(AParamTypes)-1);
+    Result.FVariableArgumentCount := true;
+  end else
+    Result.ParameterTypes := AParamTypes;
   Result.ResultType:=CharToResultType(AResultType);
   Result.FNodeType:=ANodeClass;
 end;
@@ -2364,7 +2378,10 @@ end;
 
 function TFPExprIdentifierDef.ArgumentCount: Integer;
 begin
-  Result:=Length(FArgumentTypes);
+  if FVariableArgumentCount then
+    Result := -Length(FArgumentTypes)
+  else
+    Result:=Length(FArgumentTypes);
 end;
 
 procedure TFPExprIdentifierDef.Assign(Source: TPersistent);
@@ -2379,6 +2396,7 @@ begin
     FStringValue:=EID.FStringValue;
     FValue:=EID.FValue;
     FArgumentTypes:=EID.FArgumentTypes;
+    FVariableArgumentCount := EID.FVariableArgumentCount;
     FIDType:=EID.FIDType;
     FName:=EID.FName;
     FOnGetValue:=EID.FOnGetValue;
@@ -3791,11 +3809,14 @@ Var
   rtp,rta : TResultType;
 
 begin
-  If Length(FArgumentNodes)<>FID.ArgumentCount then
+  If (Length(FArgumentNodes)<>FID.ArgumentCount) and not FID.VariableArgumentCount then
     RaiseParserError(ErrInvalidArgumentCount,[FID.Name]);
   For I:=0 to Length(FArgumentNodes)-1 do
     begin
-    rtp:=CharToResultType(FID.ParameterTypes[i+1]);
+    if (i < Length(FID.ParameterTypes)) then
+      rtp := CharToResultType(FID.ParameterTypes[i+1])
+    else if FID.VariableArgumentCount then
+      rtp := CharToResultType(FID.ParameterTypes[Length(FID.ParameterTypes)]);
     rta:=FArgumentNodes[i].NodeType;
     If (rtp<>rta) then
       FArgumentNodes[i]:=ConvertArgument(I+1,FArgumentNodes[i],rtp);
@@ -4463,3 +4484,4 @@ initialization
 finalization
   FreeBuiltins;
 end.
+

packages/fcl-base/tests/testexprpars.pp

@@ -783,10 +783,14 @@ type
   end;
 
   { TTestParserFunctions }
-
   TTestParserFunctions = Class(TTestExpressionParser)
   private
     FAccessAs : TResultType;
+    procedure ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+    procedure ExprMaxOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+    procedure ExprMinOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+    procedure ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+    procedure ExprSumOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
     Procedure TryRead;
     procedure TryWrite;
   Published
@@ -823,8 +827,16 @@ type
     procedure TestFunction31;
     procedure TestFunction32;
     procedure TestFunction33;
+    procedure TestVarArgs1;
+    procedure TestVarArgs2;
+    procedure TestVarArgs3;
+    procedure TestVarArgs4;
+    procedure TestVarArgs5;
   end;
 
+
+
+
   { TAggregateNode }
 
   TAggregateNode = Class(TFPExprNode)
@@ -5466,6 +5478,105 @@ begin
   AssertCurrencyResult(1.234);
 end;
 
+procedure TTestParserFunctions.ExprMaxOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
+var
+  mx: Double;
+  arg: TFPExpressionResult;
+begin
+  mx := -MaxDouble;
+  for arg in Args do
+    mx := math.Max(mx, ArgToFloat(arg));
+  result.ResFloat:= mx;
+end;
+
+procedure TTestParserFunctions.ExprMinOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
+var
+  mn: Double;
+  arg: TFPExpressionResult;
+begin
+  mn := MaxDouble;
+  for arg in Args do
+    mn := math.Min(mn, ArgToFloat(arg));
+  result.ResFloat:= mn;
+end;
+
+procedure TTestParserFunctions.ExprSumOf(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
+var
+  sum: Double;
+  arg: TFPExpressionResult;
+begin
+  sum := 0;
+  for arg in Args do
+    sum := sum + ArgToFloat(arg);
+  Result.ResFloat := sum;
+end;
+
+procedure TTestParserFunctions.ExprAveOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+var
+  sum: Double;
+  arg: TFPExpressionResult;
+begin
+  if Length(Args) = 0 then
+    raise EExprParser.Create('At least 1 value needed for calculation of average');
+  sum := 0;
+  for arg in Args do
+    sum := sum + ArgToFloat(arg);
+  Result.ResFloat := sum / Length(Args);
+end;
+
+procedure TTestParserFunctions.ExprStdDevOf(var Result: TFPExpressionResult; const Args: TExprParameterArray);
+var
+  sum, ave: Double;
+  arg: TFPExpressionResult;
+begin
+  if Length(Args) < 2 then
+    raise EExprParser.Create('At least 2 values needed for calculation of standard deviation');
+  sum := 0;
+  for arg in Args do
+    sum := sum + ArgToFloat(arg);
+  ave := sum / Length(Args);
+  sum := 0;
+  for arg in Args do
+    sum := sum + sqr(ArgToFloat(arg) - ave);
+  Result.ResFloat := sqrt(sum / (Length(Args) - 1));
+end;
+
+procedure TTestParserFunctions.TestVarArgs1;
+begin
+ // FP.BuiltIns := [bcMath];
+  FP.Identifiers.AddFunction('MaxOf', 'F', 'F+', @ExprMaxOf);
+  FP.Expression := 'MaxOf(-1,2,3,4.1)';
+  AssertEquals('Result',4.1,FP.Evaluate.ResFloat,0.1);
+end;
+
+procedure TTestParserFunctions.TestVarArgs2;
+begin
+  FP.Identifiers.AddFunction('MinOf', 'F', 'F+', @ExprMinOf);
+  FP.Expression := 'MinOf(-1,2,3,4.1)';
+  AssertEquals('Result',-1,FP.Evaluate.ResFloat,0.1);
+end;
+
+procedure TTestParserFunctions.TestVarArgs3;
+begin
+  FP.Identifiers.AddFunction('SumOf', 'F', 'F+', @ExprSumOf);
+  FP.Expression := 'SumOf(-1,2,3,4.1)';
+  AssertEquals('Result',8.1,FP.Evaluate.ResFloat,0.1);
+end;
+
+procedure TTestParserFunctions.TestVarArgs4;
+begin
+  FP.Identifiers.AddFunction('AveOf', 'F', 'F+', @ExprAveOf);
+  FP.Expression := 'AveOf(-1,2,3,4.1)';
+  AssertEquals('Result',2.025,FP.Evaluate.ResFloat,0.001);
+end;
+
+procedure TTestParserFunctions.TestVarArgs5;
+begin
+  FP.Identifiers.AddFunction('StdDevOf', 'F', 'F+', @ExprStdDevOf);
+  FP.Expression := 'StdDevOf(-1,2,3,4.1)';
+  AssertEquals('Result',2.191,FP.Evaluate.ResFloat,0.001);
+end;
+
 procedure TTestParserFunctions.TestFunction17;
 
 Var