* Merging revisions r43636,r43637 from trunk:

    ------------------------------------------------------------------------
    r43636 | michael | 2019-12-04 12:30:04 +0100 (Wed, 04 Dec 2019) | 1 line
    
    * Patch by Werner Pamler to delete builtin (bug ID 36396)
    ------------------------------------------------------------------------
    r43637 | michael | 2019-12-04 12:42:48 +0100 (Wed, 04 Dec 2019) | 1 line
    
    * Added possibility for array arguments
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@43638 -

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;
 
 
@@ -807,6 +809,8 @@ Type
     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;
+    Procedure Delete(AIndex: Integer);
+    Function Remove(aIdentifier : String) : Integer;
     Property IdentifierCount : Integer Read GetCount;
     Property Identifiers[AIndex : Integer] :TFPBuiltInExprIdentifierDef Read GetI;
   end;
@@ -2270,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;
@@ -2282,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;
@@ -2294,11 +2306,16 @@ 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;
 
+
 { ---------------------------------------------------------------------
   TFPExprIdentifierDef
   ---------------------------------------------------------------------}
@@ -2361,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);
@@ -2376,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;
@@ -2667,6 +2688,18 @@ begin
   Result. Category:=ACategory;
 end;
 
+procedure TExprBuiltInManager.Delete(AIndex: Integer);
+begin
+  FDefs.Delete(AIndex);
+end;
+
+function TExprBuiltInManager.Remove(aIdentifier: String): Integer;
+begin
+  Result:=IndexOfIdentifier(aIdentifier);
+  if Result<>-1 then
+    Delete(Result);
+end;
+
 
 { ---------------------------------------------------------------------
   Various Nodes
@@ -3776,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);
@@ -4448,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)
@@ -884,6 +896,8 @@ type
     procedure TestVariable7;
     procedure TestFunction1;
     procedure TestFunction2;
+    procedure TestDelete;
+    procedure TestRemove;
   end;
 
   TTestBuiltins = Class(TTestExpressionParser)
@@ -5464,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
@@ -5845,6 +5958,34 @@ begin
   AssertNull('FindIdentifier returns no result',I2);
 end;
 
+procedure TTestBuiltinsManager.TestDelete;
+
+begin
+  FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
+  FM.AddFunction(bcUser,'EchoDate2','D','D',@EchoDate);
+  FM.AddFunction(bcUser,'EchoDate3','D','D',@EchoDate);
+  AssertEquals('Count before',3,FM.IdentifierCount);
+  FM.Delete(2);
+  AssertEquals('Count after',2,FM.IdentifierCount);
+  AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate3'));
+  AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
+  AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate2'));
+end;
+
+procedure TTestBuiltinsManager.TestRemove;
+begin
+  FM.AddFunction(bcUser,'EchoDate','D','D',@EchoDate);
+  FM.AddFunction(bcUser,'EchoDate2','D','D',@EchoDate);
+  FM.AddFunction(bcUser,'EchoDate3','D','D',@EchoDate);
+  AssertEquals('Count before',3,FM.IdentifierCount);
+  AssertEquals('Result ',1,FM.Remove('EchoDate2'));
+  AssertEquals('Count after',2,FM.IdentifierCount);
+  AssertEquals('No more',-1,FM.IndexOfIdentifier('EchoDate2'));
+  AssertEquals('Left 1',0,FM.IndexOfIdentifier('EchoDate'));
+  AssertEquals('Left 2',1,FM.IndexOfIdentifier('EchoDate3'));
+  AssertEquals('Result ',-1,FM.Remove('Nono'));
+end;
+
 { TTestBuiltins }
 
 procedure TTestBuiltins.Setup;