* Add support for currency type

git-svn-id: trunk@38523 -

packages/fcl-base/src/fpexprpars.pp

@@ -85,7 +85,7 @@ Type
 
   EExprScanner = Class(Exception);
 
-  TResultType = (rtBoolean,rtInteger,rtFloat,rtDateTime,rtString);
+  TResultType = (rtBoolean,rtInteger,rtFloat,rtDateTime,rtString,rtCurrency);
   TResultTypes = set of TResultType;
 
   TFPExpressionResult = record
@@ -94,6 +94,7 @@ Type
       rtBoolean  : (ResBoolean  : Boolean);
       rtInteger  : (ResInteger  : Int64);
       rtFloat    : (ResFloat    : TExprFloat);
+      rtCurrency : (ResCurrency : Currency);
       rtDateTime : (ResDateTime : TDatetime);
       rtString   : ();
   end;
@@ -389,12 +390,21 @@ Type
   end;
 
   { TIntToFloatNode }
+
   TIntToFloatNode = Class(TIntConvertNode)
   Public
     Function NodeType : TResultType;  override;
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
   end;
 
+  { TIntToCurrencyNode }
+
+  TIntToCurrencyNode = Class(TIntConvertNode)
+  Public
+    Function NodeType : TResultType;  override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
+  end;
+
   { TIntToDateTimeNode }
 
   TIntToDateTimeNode = Class(TIntConvertNode)
@@ -412,6 +422,34 @@ Type
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
   end;
 
+  { TFloatToCurrencyNode }
+
+  TFloatToCurrencyNode = Class(TFPConvertNode)
+  Public
+    Procedure Check; override;
+    Function NodeType : TResultType;  override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
+  end;
+
+  { TCurrencyToDateTimeNode }
+
+  TCurrencyToDateTimeNode = Class(TFPConvertNode)
+  Public
+    Procedure Check; override;
+    Function NodeType : TResultType;  override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
+  end;
+
+  { TCurrencyToFloatNode }
+
+  TCurrencyToFloatNode = Class(TFPConvertNode)
+  Public
+    Procedure Check; override;
+    Function NodeType : TResultType;  override;
+    Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
+  end;
+
+
   { TFPNegateOperation }
 
   TFPNegateOperation = Class(TFPUnaryOperator)
@@ -433,6 +471,7 @@ Type
     Constructor CreateDateTime(AValue : TDateTime);
     Constructor CreateFloat(AValue : TExprFloat);
     Constructor CreateBoolean(AValue : Boolean);
+    constructor CreateCurrency(AValue: Currency);
     Procedure Check; override;
     Function NodeType : TResultType;  override;
     Procedure GetNodeValue(var Result : TFPExpressionResult);  override;
@@ -465,6 +504,7 @@ Type
     function GetAsBoolean: Boolean;
     function GetAsDateTime: TDateTime;
     function GetAsFloat: TExprFloat;
+    function GetAsCurrency : Currency;
     function GetAsInteger: Int64;
     function GetAsString: String;
     function GetResultType: TResultType;
@@ -473,6 +513,7 @@ Type
     procedure SetAsBoolean(const AValue: Boolean);
     procedure SetAsDateTime(const AValue: TDateTime);
     procedure SetAsFloat(const AValue: TExprFloat);
+    procedure SetAsCurrency(const AValue: Currency);
     procedure SetAsInteger(const AValue: Int64);
     procedure SetAsString(const AValue: String);
     procedure SetName(const AValue: ShortString);
@@ -487,6 +528,7 @@ Type
     Procedure Assign(Source : TPersistent); override;
     Function EventBasedVariable : Boolean; Inline;
     Property AsFloat : TExprFloat Read GetAsFloat Write SetAsFloat;
+    Property AsCurrency : Currency Read GetAsCurrency Write SetAsCurrency;
     Property AsInteger : Int64 Read GetAsInteger Write SetAsInteger;
     Property AsString : String Read GetAsString Write SetAsString;
     Property AsBoolean : Boolean Read GetAsBoolean Write SetAsBoolean;
@@ -539,6 +581,7 @@ Type
     Function AddBooleanVariable(Const AName : ShortString; AValue : Boolean) : TFPExprIdentifierDef;
     Function AddIntegerVariable(Const AName : ShortString; AValue : Integer) : TFPExprIdentifierDef;
     Function AddFloatVariable(Const AName : ShortString; AValue : TExprFloat) : TFPExprIdentifierDef;
+    Function AddCurrencyVariable(Const AName : ShortString; AValue : Currency) : TFPExprIdentifierDef;
     Function AddStringVariable(Const AName : ShortString; AValue : String) : TFPExprIdentifierDef;
     Function AddDateTimeVariable(Const AName : ShortString; AValue : TDateTime) : TFPExprIdentifierDef;
     Function AddFunction(Const AName : ShortString; Const AResultType : Char; Const AParamTypes : String; ACallBack : TFPExprFunctionCallBack) : TFPExprIdentifierDef;
@@ -576,6 +619,7 @@ Type
     FargumentParams : TExprParameterArray;
   Protected
     Procedure CalcParams;
+    function ConvertArgument(aIndex: Integer; aNode: TFPExprNode; aType: TResultType): TFPExprNode; virtual;
   Public
     Procedure Check; override;
     Constructor CreateFunction(AID : TFPExprIdentifierDef; Const Args : TExprArgumentArray); virtual;
@@ -622,6 +666,7 @@ Type
 
   TAggregateSum = Class(TAggregateExpr)
   Public
+    function ConvertArgument(aIndex: Integer; aNode: TFPExprNode; aType: TResultType): TFPExprNode; override;
     Procedure InitAggregate; override;
     Procedure UpdateAggregate; override;
   end;
@@ -679,10 +724,10 @@ Type
     FHashList : TFPHashObjectlist;
     FDirty : Boolean;
     procedure CheckEOF;
-    function ConvertNode(Todo: TFPExprNode; ToType: TResultType): TFPExprNode;
     function GetAsBoolean: Boolean;
     function GetAsDateTime: TDateTime;
     function GetAsFloat: TExprFloat;
+    function GetAsCurrency: Currency;
     function GetAsInteger: Int64;
     function GetAsString: String;
     function MatchNodes(Todo, Match: TFPExprNode): TFPExprNode;
@@ -693,6 +738,8 @@ Type
     procedure ParserError(Msg: String);
     procedure SetExpression(const AValue: String); virtual;
     Procedure CheckResultType(Const Res :TFPExpressionResult; AType : TResultType); inline;
+    Procedure CheckResultTypes(Const Res :TFPExpressionResult; ATypes : TResultTypes); inline;
+    Class function ConvertNode(Todo: TFPExprNode; ToType: TResultType): TFPExprNode;
     class Function BuiltinsManager : TExprBuiltInManager;
     Function Level1 : TFPExprNode;
     Function Level2 : TFPExprNode;
@@ -714,7 +761,7 @@ Type
     Destructor Destroy; override;
     Function IdentifierByName(const AName : ShortString) : TFPExprIdentifierDef; virtual;
     Procedure Clear;
-    Procedure EvaluateExpression(Var Result : TFPExpressionResult);
+    Procedure EvaluateExpression(Out Result : TFPExpressionResult);
     function ExtractNode(var N: TFPExprNode): Boolean;
     Function Evaluate : TFPExpressionResult;
     Function ResultType : TResultType;
@@ -722,6 +769,7 @@ Type
     Procedure InitAggregate;
     Procedure UpdateAggregate;
     Property AsFloat : TExprFloat Read GetAsFloat;
+    Property AsCurrency : Currency Read GetAsCurrency;
     Property AsInteger : Int64 Read GetAsInteger;
     Property AsString : String Read GetAsString;
     Property AsBoolean : Boolean Read GetAsBoolean;
@@ -752,6 +800,7 @@ Type
     Function AddBooleanVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : Boolean) : TFPBuiltInExprIdentifierDef;
     Function AddIntegerVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : Integer) : TFPBuiltInExprIdentifierDef;
     Function AddFloatVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : TExprFloat) : TFPBuiltInExprIdentifierDef;
+    Function AddCurrencyVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : Currency) : TFPBuiltInExprIdentifierDef;
     Function AddStringVariable(Const ACategory : TBuiltInCategory; Const AName : ShortString; AValue : String) : TFPBuiltInExprIdentifierDef;
     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;
@@ -877,6 +926,7 @@ begin
     'B' : Result:=rtBoolean;
     'I' : Result:=rtInteger;
     'F' : Result:=rtFloat;
+    'C' : Result:=rtCurrency;
   else
     RaiseParserError(SErrInvalidResultCharacter,[C]);
   end;
@@ -899,6 +949,39 @@ begin
   FreeAndNil(Builtins);
 end;
 
+{ TFloatToCurrencyNode }
+
+procedure TFloatToCurrencyNode.Check;
+begin
+  CheckNodeType(Operand,[rtFloat]);
+end;
+
+function TFloatToCurrencyNode.NodeType: TResultType;
+begin
+  Result:=rtCurrency;
+end;
+
+procedure TFloatToCurrencyNode.GetNodeValue(var Result: TFPExpressionResult);
+begin
+  Operand.GetNodeValue(Result);
+  Result.ResultType:=rtCurrency;
+  Result.ResCurrency:=Result.ResFloat;
+end;
+
+{ TIntToCurrencyNode }
+
+function TIntToCurrencyNode.NodeType: TResultType;
+begin
+  Result:=rtCurrency;
+end;
+
+procedure TIntToCurrencyNode.GetNodeValue(var Result: TFPExpressionResult);
+begin
+  Operand.GetNodeValue(Result);
+  Result.ResCurrency:=Result.ResInteger;
+  Result.ResultType:=rtCurrency;
+end;
+
 { TFPModuloOperation }
 
 procedure TFPModuloOperation.Check;
@@ -936,47 +1019,16 @@ procedure TAggregateMax.InitAggregate;
 begin
   inherited InitAggregate;
   FFirst:=True;
-  FResult.ResultType:=rtFloat;
+  FResult.ResultType:=FArgumentNodes[0].NodeType;
-  FResult.resFloat:=0;
+  Case FResult.ResultType of
+    rtFloat : FResult.resFloat:=0.0;
+    rtCurrency : FResult.resCurrency:=0.0;
+    rtInteger : FResult.resInteger:=0;
+  end;
 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;
@@ -989,14 +1041,57 @@ begin
     FFirst:=False;
     OK:=True;
     end
+  else
+    Case N.ResultType of
+      rtFloat: OK:=N.ResFloat>FResult.ResFloat;
+      rtCurrency: OK:=N.ResCurrency>FResult.ResCurrency;
+      rtinteger: OK:=N.ResInteger>FResult.ResFloat;
+    end;
+  if OK then
+    Case N.ResultType of
+      rtFloat: FResult.ResFloat:=N.ResFloat;
+      rtinteger: FResult.ResFloat:=N.ResInteger;
+      rtCurrency: FResult.ResCurrency:=N.ResCurrency;
+    end;
+end;
+
+{ TAggregateMin }
+
+procedure TAggregateMin.InitAggregate;
+begin
+  inherited InitAggregate;
+  FFirst:=True;
+  FResult.ResultType:=FArgumentNodes[0].NodeType;
+  Case FResult.ResultType of
+    rtFloat : FResult.resFloat:=0.0;
+    rtCurrency : FResult.resCurrency:=0.0;
+    rtInteger : FResult.resInteger:=0;
+  end;
+end;
+
+procedure TAggregateMin.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;
+      rtCurrency: OK:=N.ResCurrency<FResult.ResCurrency;
       rtinteger: OK:=N.ResInteger<FResult.ResFloat;
     end;
   if OK then
     Case FResult.ResultType of
       rtFloat: FResult.ResFloat:=N.ResFloat;
+      rtCurrency: FResult.ResCurrency:=N.ResCurrency;
       rtinteger: FResult.ResFloat:=N.ResInteger;
     end;
   inherited UpdateAggregate;
@@ -1007,7 +1102,6 @@ end;
 procedure TAggregateAvg.InitAggregate;
 begin
   inherited InitAggregate;
-  FCount:=0;
 end;
 
 procedure TAggregateAvg.UpdateAggregate;
@@ -1019,15 +1113,30 @@ end;
 procedure TAggregateAvg.GetNodeValue(var Result: TFPExpressionResult);
 begin
   inherited GetNodeValue(Result);
-  Result.ResultType:=rtFloat;
+  Result.ResultType:=FResult.ResultType;
   if FCount=0 then
-    Result.ResFloat:=0
+    Case FResult.ResultType of
+      rtInteger:
+        begin
+        Result.ResultType:=rtFloat;
+        Result.ResFloat:=0.0;
+        end;
+      rtFloat:
+        Result.ResFloat:=0.0;
+      rtCurrency:
+        Result.ResCurrency:=0.0;
+    end
   else
     Case FResult.ResultType of
       rtInteger:
+        begin
+        Result.ResultType:=rtFloat;
         Result.ResFloat:=FResult.ResInteger/FCount;
+        end;
       rtFloat:
         Result.ResFloat:=FResult.ResFloat/FCount;
+      rtCurrency:
+        Result.ResCurrency:=FResult.ResCurrency/FCount;
     end;
 end;
 
@@ -1058,12 +1167,20 @@ end;
 
 { TAggregateSum }
 
+function TAggregateSum.ConvertArgument(aIndex: Integer; aNode: TFPExprNode; aType: TResultType): TFPExprNode;
+begin
+  if not (aNode.NodeType in [rtFloat,rtInteger,rtCurrency]) then
+    RaiseParserError(SErrInvalidArgumentType,[aIndex,ResultTypeName(aType),ResultTypeName(aNode.NodeType)]);
+  Result:=aNode;
+end;
 
 procedure TAggregateSum.InitAggregate;
+
 begin
   FResult.ResultType:=FArgumentNodes[0].NodeType;
   Case FResult.ResultType of
     rtFloat: FResult.ResFloat:=0.0;
+    rtCurrency : FResult.ResCurrency:=0.0;
     rtinteger: FResult.ResInteger:=0;
   end;
 end;
@@ -1077,6 +1194,7 @@ begin
   FArgumentNodes[0].GetNodeValue(R);
   Case FResult.ResultType of
     rtFloat: FResult.ResFloat:=FResult.ResFloat+R.ResFloat;
+    rtCurrency: FResult.ResCurrency:=FResult.ResCurrency+R.ResCurrency;
     rtinteger: FResult.ResInteger:=FResult.ResInteger+R.ResInteger;
   end;
 end;
@@ -1468,7 +1586,7 @@ begin
   FIdentifiers.Assign(AValue)
 end;
 
-procedure TFPExpressionParser.EvaluateExpression(var Result: TFPExpressionResult);
+procedure TFPExpressionParser.EvaluateExpression(Out Result: TFPExpressionResult);
 begin
   If (FExpression='') then
     ParserError(SErrInExpressionEmpty);
@@ -1493,19 +1611,26 @@ begin
   Raise EExprParser.Create(Msg);
 end;
 
-function TFPExpressionParser.ConvertNode(Todo : TFPExprNode; ToType : TResultType): TFPExprNode;
+Class function TFPExpressionParser.ConvertNode(Todo : TFPExprNode; ToType : TResultType): TFPExprNode;
 begin
   Result:=ToDo;
   Case ToDo.NodeType of
     rtInteger :
       Case ToType of
         rtFloat    : Result:=TIntToFloatNode.Create(Result);
+        rtCurrency : Result:=TIntToCurrencyNode.Create(Result);
         rtDateTime : Result:=TIntToDateTimeNode.Create(Result);
       end;
     rtFloat :
       Case ToType of
+        rtCurrency : Result:=TFloatToCurrencyNode.Create(Result);
         rtDateTime : Result:=TFloatToDateTimeNode.Create(Result);
       end;
+    rtCurrency :
+      Case ToType of
+        rtFloat    : Result:=TCurrencyToFloatNode.Create(Result);
+        rtDateTime : Result:=TCurrencyToDateTimeNode.Create(Result);
+      end;
   end;
 end;
 
@@ -1537,8 +1662,26 @@ var
 
 begin
   EvaluateExpression(Res);
-  CheckResultType(Res,rtFloat);
+  CheckResultTypes(Res,[rtFloat,rtCurrency,rtInteger]);
-  Result:=Res.ResFloat;
+  case Res.ResultType of
+    rtInteger : Result:=Res.ResInteger;
+    rtFloat : Result:=Res.ResFloat;
+    rtCurrency : Result:=res.ResCurrency;
+  end;
+end;
+
+function TFPExpressionParser.GetAsCurrency: Currency;
+var
+  Res: TFPExpressionResult;
+
+begin
+  EvaluateExpression(Res);
+  CheckResultTypes(Res,[rtFloat,rtCurrency,rtInteger]);
+  case Res.ResultType of
+    rtInteger : Result:=Res.ResInteger;
+    rtFloat : Result:=Res.ResFloat;
+    rtCurrency : Result:=res.ResCurrency;
+  end;
 end;
 
 function TFPExpressionParser.GetAsInteger: Int64;
@@ -1572,24 +1715,23 @@ end;
 function TFPExpressionParser.MatchNodes(Todo,Match : TFPExprNode): TFPExprNode;
 
 Var
-  TT,MT : TResultType;
+  FromType,ToType : TResultType;
 
 begin
   Result:=Todo;
-  TT:=Todo.NodeType;
+  FromType:=Todo.NodeType;
-  MT:=Match.NodeType;
+  ToType:=Match.NodeType;
-  If (TT<>MT) then
+  If (FromType<>ToType) then
-    begin
+    Case FromType of
-    if (TT=rtInteger) then
+    rtInteger:
-      begin
+      if (ToType in [rtFloat,rtCurrency,rtDateTime]) then
-      if (MT in [rtFloat,rtDateTime]) then
+        Result:=ConvertNode(Todo,toType);
-        Result:=ConvertNode(Todo,MT);
+    rtFloat:
-      end
+      if (ToType in [rtCurrency,rtDateTime]) then
-    else if (TT=rtFloat) then
+        Result:=ConvertNode(Todo,toType);
-      begin
+    rtCurrency:
-      if (MT=rtDateTime) then
+      if (ToType in [rtFloat,rtDateTime]) then
-        Result:=ConvertNode(Todo,rtDateTime);
+        Result:=ConvertNode(Todo,toType);
-      end;
     end;
 end;
 
@@ -1937,6 +2079,12 @@ begin
     RaiseParserError(SErrInvalidResultType,[ResultTypeName(Res.ResultType)]);
 end;
 
+procedure TFPExpressionParser.CheckResultTypes(const Res: TFPExpressionResult; ATypes: TResultTypes);
+begin
+  If Not (Res.ResultType in ATypes) then
+    RaiseParserError(SErrInvalidResultType,[ResultTypeName(Res.ResultType)]);
+end;
+
 class function TFPExpressionParser.BuiltinsManager: TExprBuiltInManager;
 begin
   Result:=BuiltinIdentifiers;
@@ -2085,6 +2233,15 @@ begin
   Result.FValue.ResFloat:=AValue;
 end;
 
+function TFPExprIdentifierDefs.AddCurrencyVariable(const AName: ShortString; AValue: Currency): TFPExprIdentifierDef;
+begin
+  Result:=Add as TFPExprIdentifierDef;
+  Result.IdentifierType:=itVariable;
+  Result.Name:=AName;
+  Result.ResultType:=rtCurrency;
+  Result.FValue.ResCurrency:=AValue;
+end;
+
 function TFPExprIdentifierDefs.AddStringVariable(const AName: ShortString;
   AValue: String): TFPExprIdentifierDef;
 begin
@@ -2172,6 +2329,7 @@ begin
       rtBoolean  : FValue.ResBoolean:=FStringValue='True';
       rtInteger  : FValue.ResInteger:=StrToInt(AValue);
       rtFloat    : FValue.ResFloat:=StrToFloat(AValue, FileFormatSettings);
+      rtCurrency : FValue.ResFloat:=StrToCurr(AValue, FileFormatSettings);
       rtDateTime : FValue.ResDateTime:=StrToDateTime(AValue, FileFormatSettings);
       rtString   : FValue.ResString:=AValue;
     end
@@ -2180,6 +2338,7 @@ begin
       rtBoolean  : FValue.ResBoolean:=False;
       rtInteger  : FValue.ResInteger:=0;
       rtFloat    : FValue.ResFloat:=0.0;
+      rtCurrency : FValue.ResCurrency:=0.0;
       rtDateTime : FValue.ResDateTime:=0;
       rtString   : FValue.ResString:='';
     end
@@ -2260,6 +2419,13 @@ begin
   FValue.ResFloat:=AValue;
 end;
 
+procedure TFPExprIdentifierDef.SetAsCurrency(const AValue: Currency);
+begin
+  CheckVariable;
+  CheckResultType(rtCurrency);
+  FValue.ResCurrency:=AValue;
+end;
+
 procedure TFPExprIdentifierDef.SetAsInteger(const AValue: Int64);
 begin
   CheckVariable;
@@ -2283,6 +2449,7 @@ begin
                    Result:='False';
     rtInteger  : Result:=IntToStr(FValue.ResInteger);
     rtFloat    : Result:=FloatToStr(FValue.ResFloat, FileFormatSettings);
+    rtCurrency : Result:=CurrToStr(FValue.ResCurrency, FileFormatSettings);
     rtDateTime : Result:=FormatDateTime('cccc',FValue.ResDateTime, FileFormatSettings);
     rtString   : Result:=FValue.ResString;
   end;
@@ -2304,7 +2471,7 @@ begin
   if RT2<>RT then
     begin
     // Automatically convert integer to float.
-    if (rt2=rtInteger) and (rt=rtFLoat) then
+    if (rt2=rtInteger) and (rt=rtFloat) then
       begin
       FValue.ResultType:=RT;
       I:=FValue.resInteger;
@@ -2340,6 +2507,13 @@ begin
   Result:=FValue.ResFloat;
 end;
 
+function TFPExprIdentifierDef.GetAsCurrency: Currency;
+begin
+  CheckResultType(rtCurrency);
+  CheckVariable;
+  Result:=FValue.ResCurrency;
+end;
+
 function TFPExprIdentifierDef.GetAsBoolean: Boolean;
 begin
   CheckResultType(rtBoolean);
@@ -2445,6 +2619,13 @@ begin
   Result.Category:=ACategory;
 end;
 
+function TExprBuiltInManager.AddCurrencyVariable(const ACategory: TBuiltInCategory; const AName: ShortString; AValue: Currency
+  ): TFPBuiltInExprIdentifierDef;
+begin
+  Result:=TFPBuiltInExprIdentifierDef(FDefs.AddCurrencyVariable(AName,AValue));
+  Result.Category:=ACategory;
+end;
+
 function TExprBuiltInManager.AddStringVariable(
   const ACategory: TBuiltInCategory; const AName: ShortString; AValue: String
   ): TFPBuiltInExprIdentifierDef;
@@ -2621,6 +2802,13 @@ begin
   FValue.ResFloat:=AValue;
 end;
 
+constructor TFPConstExpression.CreateCurrency(AValue: Currency);
+begin
+  Inherited create;
+  FValue.ResultType:=rtCurrency;
+  FValue.ResCurrency:=AValue;
+end;
+
 constructor TFPConstExpression.CreateBoolean(AValue: Boolean);
 begin
   FValue.ResultType:=rtBoolean;
@@ -2650,6 +2838,7 @@ begin
     rtDateTime : Result:=''''+FormatDateTime('cccc',FValue.resDateTime)+'''';
     rtBoolean : If FValue.ResBoolean then Result:='True' else Result:='False';
     rtFloat : Str(FValue.ResFloat,Result);
+    rtCurrency : Str(FValue.ResCurrency,Result);
   end;
 end;
 
@@ -2659,7 +2848,7 @@ end;
 procedure TFPNegateOperation.Check;
 begin
   Inherited;
-  If Not (Operand.NodeType in [rtInteger,rtFloat]) then
+  If Not (Operand.NodeType in [rtInteger,rtFloat,rtCurrency]) then
     RaiseParserError(SErrNoNegation,[ResultTypeName(Operand.NodeType),Operand.AsString])
 end;
 
@@ -2674,6 +2863,7 @@ begin
   Case Result.ResultType of
     rtInteger : Result.resInteger:=-Result.ResInteger;
     rtFloat : Result.resFloat:=-Result.ResFloat;
+    rtCurrency : Result.resCurrency:=-Result.ResCurrency;
   end;
 end;
 
@@ -2917,7 +3107,8 @@ begin
     Case RT.ResultType of
       rtBoolean  : B:=RT.ResBoolean=RV.ResBoolean;
       rtInteger  : B:=RT.ResInteger=RV.ResInteger;
-      rtFloat    : B:=RT.ResFloat=RV.ResFLoat;
+      rtFloat    : B:=RT.ResFloat=RV.ResFloat;
+      rtCurrency : B:=RT.resCurrency=RV.resCurrency;
       rtDateTime : B:=RT.ResDateTime=RV.ResDateTime;
       rtString   : B:=RT.ResString=RV.ResString;
     end;
@@ -3072,7 +3263,8 @@ begin
   Case Result.ResultType of
     rtBoolean  : Result.resBoolean:=Result.ResBoolean=RRes.ResBoolean;
     rtInteger  : Result.resBoolean:=Result.ResInteger=RRes.ResInteger;
-    rtFloat    : Result.resBoolean:=Result.ResFloat=RRes.ResFLoat;
+    rtFloat    : Result.resBoolean:=Result.ResFloat=RRes.ResFloat;
+    rtCurrency : Result.resBoolean:=Result.resCurrency=RRes.resCurrency;
     rtDateTime : Result.resBoolean:=Result.ResDateTime=RRes.ResDateTime;
     rtString   : Result.resBoolean:=Result.ResString=RRes.ResString;
   end;
@@ -3109,7 +3301,8 @@ begin
   Right.GetNodeValue(RRes);
   Case Result.ResultType of
     rtInteger  : Result.resBoolean:=Result.ResInteger<RRes.ResInteger;
-    rtFloat    : Result.resBoolean:=Result.ResFloat<RRes.ResFLoat;
+    rtFloat    : Result.resBoolean:=Result.ResFloat<RRes.ResFloat;
+    rtCurrency : Result.resBoolean:=Result.resCurrency<RRes.resCurrency;
     rtDateTime : Result.resBoolean:=Result.ResDateTime<RRes.ResDateTime;
     rtString   : Result.resBoolean:=Result.ResString<RRes.ResString;
   end;
@@ -3135,10 +3328,17 @@ begin
     rtInteger : case Right.NodeType of
                   rtInteger : Result.resBoolean:=Result.ResInteger>RRes.ResInteger;
                   rtFloat : Result.resBoolean:=Result.ResInteger>RRes.ResFloat;
+                  rtCurrency : Result.resBoolean:=Result.ResInteger>RRes.resCurrency;
                 end;
     rtFloat   : case Right.NodeType of
                   rtInteger : Result.resBoolean:=Result.ResFloat>RRes.ResInteger;
-                  rtFloat : Result.resBoolean:=Result.ResFloat>RRes.ResFLoat;
+                  rtFloat : Result.resBoolean:=Result.ResFloat>RRes.ResFloat;
+                  rtCurrency : Result.resBoolean:=Result.ResFloat>RRes.ResCurrency;
+                end;
+    rtCurrency   : case Right.NodeType of
+                  rtInteger : Result.resBoolean:=Result.ResCurrency>RRes.ResInteger;
+                  rtFloat : Result.resBoolean:=Result.ResCurrency>RRes.ResFloat;
+                  rtCurrency : Result.resBoolean:=Result.ResCurrency>RRes.ResCurrency;
                 end;
     rtDateTime : Result.resBoolean:=Result.ResDateTime>RRes.ResDateTime;
     rtString   : Result.resBoolean:=Result.ResString>RRes.ResString;
@@ -3177,7 +3377,7 @@ end;
 procedure TFPOrderingOperation.Check;
 
 Const
-  AllowedTypes =[rtInteger,rtfloat,rtDateTime,rtString];
+  AllowedTypes =[rtInteger,rtfloat,rtCurrency,rtDateTime,rtString];
 
 begin
   CheckNodeType(Left,AllowedTypes);
@@ -3190,7 +3390,7 @@ end;
 procedure TMathOperation.Check;
 
 Const
-  AllowedTypes =[rtInteger,rtfloat,rtDateTime,rtString];
+  AllowedTypes =[rtInteger,rtfloat,rtCurrency,rtDateTime,rtString];
 
 begin
   inherited Check;
@@ -3223,7 +3423,8 @@ begin
     rtInteger  : Result.ResInteger:=Result.ResInteger+RRes.ResInteger;
     rtString   : Result.ResString:=Result.ResString+RRes.ResString;
     rtDateTime : Result.ResDateTime:=Result.ResDateTime+RRes.ResDateTime;
-    rtFloat    : Result.ResFLoat:=Result.ResFLoat+RRes.ResFLoat;
+    rtFloat    : Result.ResFloat:=Result.ResFloat+RRes.ResFloat;
+    rtCurrency : Result.ResCurrency:=Result.ResCurrency+RRes.ResCurrency;
   end;
   Result.ResultType:=NodeType;
 end;
@@ -3233,7 +3434,7 @@ end;
 procedure TFPSubtractOperation.check;
 
 Const
-  AllowedTypes =[rtInteger,rtfloat,rtDateTime];
+  AllowedTypes =[rtInteger,rtfloat,rtCurrency,rtDateTime];
 
 begin
   CheckNodeType(Left,AllowedTypes);
@@ -3257,7 +3458,8 @@ begin
   case Result.ResultType of
     rtInteger  : Result.ResInteger:=Result.ResInteger-RRes.ResInteger;
     rtDateTime : Result.ResDateTime:=Result.ResDateTime-RRes.ResDateTime;
-    rtFloat    : Result.ResFLoat:=Result.ResFLoat-RRes.ResFLoat;
+    rtFloat    : Result.ResFloat:=Result.ResFloat-RRes.ResFloat;
+    rtCurrency : Result.resCurrency:=Result.resCurrency-RRes.ResCurrency;
   end;
 end;
 
@@ -3266,7 +3468,7 @@ end;
 procedure TFPMultiplyOperation.check;
 
 Const
-  AllowedTypes =[rtInteger,rtfloat];
+  AllowedTypes =[rtInteger,rtCurrency,rtfloat];
 
 begin
   CheckNodeType(Left,AllowedTypes);
@@ -3288,7 +3490,8 @@ begin
   Right.GetNodeValue(RRes);
   case Result.ResultType of
     rtInteger  : Result.ResInteger:=Result.ResInteger*RRes.ResInteger;
-    rtFloat    : Result.ResFLoat:=Result.ResFLoat*RRes.ResFLoat;
+    rtFloat    : Result.ResFloat:=Result.ResFloat*RRes.ResFloat;
+    rtCurrency : Result.ResCurrency:=Result.ResCurrency*RRes.ResCurrency;
   end;
 end;
 
@@ -3296,7 +3499,7 @@ end;
 
 procedure TFPDivideOperation.check;
 Const
-  AllowedTypes =[rtInteger,rtfloat];
+  AllowedTypes =[rtInteger,rtCurrency,rtfloat];
 
 begin
   CheckNodeType(Left,AllowedTypes);
@@ -3310,8 +3513,12 @@ begin
 end;
 
 function TFPDivideOperation.NodeType: TResultType;
+
 begin
-  Result:=rtFLoat;
+  if (Left.NodeType=rtCurrency) and (Right.NodeType=rtCurrency) then
+    Result:=rtCurrency
+  else
+    Result:=rtFloat;
 end;
 
 Procedure TFPDivideOperation.GetNodeValue(var Result : TFPExpressionResult);
@@ -3324,16 +3531,21 @@ begin
   Right.GetNodeValue(RRes);
   case Result.ResultType of
     rtInteger  : Result.ResFloat:=Result.ResInteger/RRes.ResInteger;
-    rtFloat    : Result.ResFLoat:=Result.ResFLoat/RRes.ResFLoat;
+    rtFloat    : Result.ResFloat:=Result.ResFloat/RRes.ResFloat;
+    rtCurrency :
+        if NodeType=rtCurrency then
+          Result.ResCurrency:=Result.ResCurrency/RRes.ResCurrency
+        else
+          Result.ResFloat:=Result.ResFloat/RRes.ResFloat;
   end;
-  Result.ResultType:=rtFloat;
+  Result.ResultType:=NodeType;
 end;
 
 { TFPPowerOperation }
 
 procedure TFPPowerOperation.Check;
 const
-  AllowedTypes = [rtInteger, rtFloat];
+  AllowedTypes = [rtInteger, rtCurrency, rtFloat];
 begin
   CheckNodeType(Left, AllowedTypes);
   CheckNodeType(Right, AllowedTypes);
@@ -3440,6 +3652,46 @@ begin
   Result.ResultType:=rtDateTime;
 end;
 
+{ TCurrencyToDateTimeNode }
+
+procedure TCurrencyToDateTimeNode.Check;
+begin
+  inherited Check;
+  CheckNodeType(Operand,[rtCurrency]);
+end;
+
+function TCurrencyToDateTimeNode.NodeType: TResultType;
+begin
+  Result:=rtDateTime;
+end;
+
+Procedure TCurrencyToDateTimeNode.GetNodeValue(var Result : TFPExpressionResult);
+begin
+  Operand.GetNodeValue(Result);
+  Result.ResDateTime:=Result.ResCurrency;
+  Result.ResultType:=rtDateTime;
+end;
+
+{ TCurrencyToFloatNode }
+
+procedure TCurrencyToFloatNode.Check;
+begin
+  inherited Check;
+  CheckNodeType(Operand,[rtCurrency]);
+end;
+
+function TCurrencyToFloatNode.NodeType: TResultType;
+begin
+  Result:=rtFloat;
+end;
+
+Procedure TCurrencyToFloatNode.GetNodeValue(var Result : TFPExpressionResult);
+begin
+  Operand.GetNodeValue(Result);
+  Result.ResFloat:=Result.ResCurrency;
+  Result.ResultType:=rtFloat;
+end;
+
 { TFPExprIdentifierNode }
 
 constructor TFPExprIdentifierNode.CreateIdentifier(AID: TFPExprIdentifierDef);
@@ -3489,6 +3741,20 @@ begin
     end;
 end;
 
+Function TFPExprFunction.ConvertArgument(aIndex : Integer; aNode : TFPExprNode; aType : TResultType) : TFPExprNode;
+
+Var
+  N : TFPExprNode;
+
+begin
+  // Automatically convert integers to floats for float/currency parameters
+  N:=TFPExpressionParser.ConvertNode(aNode,aType);
+  if (aNode=N) then
+    // No conversion was performed, raise error
+    RaiseParserError(SErrInvalidArgumentType,[aIndex,ResultTypeName(aType),ResultTypeName(aNode.NodeType)]);
+  Result:=N;
+end;
+
 function TFPExprFunction.HasAggregate: Boolean;
 var
   I: Integer;
@@ -3515,22 +3781,13 @@ begin
     begin
     rtp:=CharToResultType(FID.ParameterTypes[i+1]);
     rta:=FArgumentNodes[i].NodeType;
-    If (rtp<>rta) then begin
+    If (rtp<>rta) then
-
+      FArgumentNodes[i]:=ConvertArgument(I+1,FArgumentNodes[i],rtp);
-      // Automatically convert integers to floats in functions that return
-      // a float
-      if (rta = rtInteger) and (rtp = rtFloat) then begin
-        FArgumentNodes[i] := TIntToFloatNode.Create(FArgumentNodes[i]);
-        exit;
-      end;
-
-      RaiseParserError(SErrInvalidArgumentType,[I+1,ResultTypeName(rtp),ResultTypeName(rta)])
-    end;
     end;
 end;
 
-constructor TFPExprFunction.CreateFunction(AID: TFPExprIdentifierDef;
+constructor TFPExprFunction.CreateFunction(AID: TFPExprIdentifierDef; const Args: TExprArgumentArray);
-  const Args: TExprArgumentArray);
+
 begin
   Inherited CreateIdentifier(AID);
   FArgumentNodes:=Args;
@@ -3637,6 +3894,8 @@ function ArgToFloat(Arg: TFPExpressionResult): TExprFloat;
 begin
   if Arg.ResultType = rtInteger then
     result := Arg.resInteger
+  else if Arg.ResultType = rtCurrency then
+    result := Arg.resCurrency
   else
     result := Arg.resFloat;
 end;

packages/fcl-base/tests/testexprpars.pp

@@ -506,6 +506,7 @@ type
     procedure DoEchoBoolean(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
     procedure DoEchoDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
     procedure DoEchoFloat(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
+    procedure DoEchoCurrency(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
     procedure DoEchoInteger(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
     procedure DoEchoString(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
     procedure DoGetDate(var Result: TFPExpressionResult; Const Args: TExprParameterArray);
@@ -518,6 +519,7 @@ type
     Procedure AssertOperand(N : TFPExprNode; OperandClass : TClass);
     Procedure AssertResultType(RT : TResultType);
     Procedure AssertResult(F : TExprFloat);
+    Procedure AssertCurrencyResult(C : Currency);
     Procedure AssertResult(I : Int64);
     Procedure AssertResult(S : String);
     Procedure AssertResult(B : Boolean);
@@ -730,9 +732,10 @@ type
     FTest33 : TFPExprIdentifierDef;
     procedure DoGetBooleanVar(var Res: TFPExpressionResult; ConstRef AName: ShortString);
     procedure DoGetBooleanVarWrong(var Res: TFPExpressionResult; ConstRef AName: ShortString);
-    procedure DoTestVariable33;
     procedure TestAccess(Skip: TResultType);
+    procedure TestAccess(Skip: TResultTypes);
   Protected
+    procedure DoTestVariable33;
     procedure AddVariabletwice;
     procedure UnknownVariable;
     Procedure ReadWrongType;
@@ -775,6 +778,8 @@ type
     procedure TestVariable32;
     procedure TestVariable33;
     procedure TestVariable34;
+    procedure TestVariable35;
+    procedure TestVariable36;
   end;
 
   { TTestParserFunctions }
@@ -814,6 +819,10 @@ type
     procedure TestFunction27;
     procedure TestFunction28;
     procedure TestFunction29;
+    procedure TestFunction30;
+    procedure TestFunction31;
+    procedure TestFunction32;
+    procedure TestFunction33;
   end;
 
   { TAggregateNode }
@@ -851,6 +860,7 @@ type
     Procedure TestCountAggregate;
     Procedure TestSumAggregate;
     Procedure TestSumAggregate2;
+    Procedure TestSumAggregate3;
     Procedure TestAvgAggregate;
     Procedure TestAvgAggregate2;
     Procedure TestAvgAggregate3;
@@ -871,6 +881,7 @@ type
     procedure TestVariable4;
     procedure TestVariable5;
     procedure TestVariable6;
+    procedure TestVariable7;
     procedure TestFunction1;
     procedure TestFunction2;
   end;
@@ -895,6 +906,7 @@ type
     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);
+    procedure AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; AUpdateCount : integer);
   Published
     procedure TestRegister;
     Procedure TestVariablepi;
@@ -962,6 +974,8 @@ type
     Procedure TestFunctionstrtodatetime;
     Procedure TestFunctionstrtodatetimedef;
     Procedure TestFunctionAggregateSum;
+    Procedure TestFunctionAggregateSumFloat;
+    Procedure TestFunctionAggregateSumCurrency;
     Procedure TestFunctionAggregateCount;
     Procedure TestFunctionAggregateAvg;
     Procedure TestFunctionAggregateMin;
@@ -1004,6 +1018,7 @@ begin
   Case Result.ResultType of
     rtInteger : Result.ResInteger:=FVarValue;
     rtFloat : Result.ResFloat:=FVarValue / 2;
+    rtCurrency : Result.ResCurrency:=FVarValue / 2;
   end;
 end;
 
@@ -1163,6 +1178,40 @@ begin
   end;
 end;
 
+procedure TTestParserAggregate.TestSumAggregate3;
+Var
+  C : TAggregateSum;
+  V : TFPExprVariable;
+  I : Integer;
+  R : TFPExpressionResult;
+  A : TExprArgumentArray;
+
+begin
+  FFunction.ResultType:=rtCurrency;
+  FFunction.ParameterTypes:='F';
+  FFunction.Name:='SUM';
+  FFunction2.ResultType:=rtCurrency;
+  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',rtCurrency,R.ResultType);
+    AssertEquals('Correct value',55/2,R.ResCurrency,0.1);
+  finally
+    C.Free;
+  end;
+end;
+
 procedure TTestParserAggregate.TestAvgAggregate;
 
 Var
@@ -1237,7 +1286,6 @@ procedure TTestParserAggregate.TestAvgAggregate3;
 Var
   C : TAggregateAvg;
   V : TFPExprVariable;
-  I : Integer;
   R : TFPExpressionResult;
   A : TExprArgumentArray;
 
@@ -1565,6 +1613,7 @@ begin
   AssertEquals('Correct result',2.34,FN.ConstValue.ResFloat);
   AssertEquals('Correct result',2.34,FN.NodeValue.ResFloat);
   Val(FN.AsString,F,C);
+  AssertEquals('Correct conversion',0,C);
   AssertEquals('AsString ok',2.34,F,0.001);
 end;
 
@@ -2828,6 +2877,12 @@ begin
   AssertEquals('Correct float result',F,FP.Evaluate.ResFloat);
 end;
 
+procedure TTestExpressionParser.AssertCurrencyResult(C: Currency);
+begin
+  AssertEquals('Correct currency result',C,FP.ExprNode.NodeValue.ResCurrency);
+  AssertEquals('Correct currency result',C,FP.Evaluate.ResCurrency);
+end;
+
 procedure TTestExpressionParser.AssertResult(I: Int64);
 begin
   AssertEquals('Correct integer result',I,FP.ExprNode.NodeValue.ResInteger);
@@ -4439,6 +4494,7 @@ begin
     rtString   : res.ResString:=FP.Identifiers[0].AsString;
     rtInteger  : Res.ResInteger:=FP.Identifiers[0].AsInteger;
     rtFloat    : Res.ResFloat:=FP.Identifiers[0].AsFloat;
+    rtCurrency : Res.ResCurrency:=FP.Identifiers[0].AsCurrency;
     rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
   end;
 end;
@@ -4455,6 +4511,7 @@ begin
     rtString   : FP.Identifiers[0].AsString:=res.ResString;
     rtInteger  : FP.Identifiers[0].AsInteger:=Res.ResInteger;
     rtFloat    : FP.Identifiers[0].AsFloat:=Res.ResFloat;
+    rtCurrency : FP.Identifiers[0].AsCurrency:=Res.ResCurrency;
     rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
   end;
 end;
@@ -4540,14 +4597,12 @@ Var
 begin
   D:=Now;
   I:=FP.Identifiers.AddDateTimeVariable('a',D);
+  AssertNotNull('Addvariable returns result',I);
   AssertException('Cannot add same name twice',EExprParser,@AddVariabletwice);
 end;
 
 procedure TTestParserVariables.TestVariable8;
 
-Var
-  I : TFPExprIdentifierDef;
-
 begin
   FP.Identifiers.AddIntegerVariable('a',123);
   FP.Identifiers.AddIntegerVariable('b',123);
@@ -4564,6 +4619,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddIntegerVariable('a',123);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='a';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
@@ -4578,6 +4634,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddStringVariable('a','a123');
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='a';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
@@ -4592,6 +4649,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddFloatVariable('a',1.23);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='a';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
@@ -4599,6 +4657,21 @@ begin
   AssertResult(1.23);
 end;
 
+procedure TTestParserVariables.TestVariable36;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddCurrencyVariable('a',1.23);
+  AssertNotNull('Addvariable returns result',I);
+  FP.Expression:='a';
+  AssertNotNull('Have result node',FP.ExprNode);
+  AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
+  AssertResultType(rtCurrency);
+  AssertCurrencyResult(1.23);
+end;
+
 procedure TTestParserVariables.TestVariable12;
 
 Var
@@ -4606,6 +4679,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddBooleanVariable('a',True);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='a';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
@@ -4622,6 +4696,7 @@ Var
 begin
   D:=Date;
   I:=FP.Identifiers.AddDateTimeVariable('a',D);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='a';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPExprVariable, FP.ExprNode);
@@ -4648,6 +4723,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddIntegerVariable('a',1);
+  AssertNotNull('Addvariable returns result',I);
   FP.BuildHashList;
   S:=FP.IdentifierByName('A');
   AssertSame('Identifier found',I,S);
@@ -4660,6 +4736,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddIntegerVariable('a',1);
+  AssertNotNull('Addvariable returns result',I);
   FP.BuildHashList;
   S:=FP.IdentifierByName('B');
   AssertNull('Identifier not found',S);
@@ -4668,10 +4745,11 @@ end;
 procedure TTestParserVariables.TestVariable17;
 
 Var
-  I,S : TFPExprIdentifierDef;
+  I : TFPExprIdentifierDef;
 
 begin
   I:=FP.Identifiers.AddIntegerVariable('a',1);
+  AssertNotNull('Addvariable returns result',I);
   FP.BuildHashList;
   AssertException('Identifier not found',EExprParser,@unknownvariable);
 end;
@@ -4683,6 +4761,7 @@ Var
 
 begin
   I:=FP.Identifiers.AddIntegerVariable('a',1);
+  AssertNotNull('Addvariable returns result',I);
   S:=FP.Identifiers.FindIdentifier('B');
   AssertNull('Identifier not found',S);
 end;
@@ -4711,18 +4790,24 @@ end;
 
 procedure TTestParserVariables.TestAccess(Skip : TResultType);
 
+begin
+  TestAccess([Skip]);
+end;
+
+procedure TTestParserVariables.TestAccess(Skip : TResultTypes);
+
 Var
   rt : TResultType;
 
 begin
   For rt:=Low(TResultType) to High(TResultType) do
-    if rt<>skip then
+    if Not (rt in skip) then
       begin
       FasWrongType:=rt;
       AssertException('Acces as '+ResultTypeName(rt),EExprParser,@ReadWrongtype);
       end;
   For rt:=Low(TResultType) to High(TResultType) do
-    if rt<>skip then
+    if Not (rt in skip) then
       begin
       FasWrongType:=rt;
       AssertException('Acces as '+ResultTypeName(rt),EExprParser,@WriteWrongtype);
@@ -4732,13 +4817,20 @@ end;
 procedure TTestParserVariables.TestVariable21;
 begin
   FP.IDentifiers.AddIntegerVariable('a',1);
-  TestAccess(rtInteger);
+  TestAccess([rtInteger]);
 end;
 
 procedure TTestParserVariables.TestVariable22;
 begin
   FP.IDentifiers.AddFloatVariable('a',1.0);
-  TestAccess(rtFloat);
+  TestAccess([rtFloat]);
+end;
+
+procedure TTestParserVariables.TestVariable35;
+
+begin
+  FP.IDentifiers.AddCurrencyVariable('a',1.0);
+  TestAccess([rtCurrency]);
 end;
 
 procedure TTestParserVariables.TestVariable23;
@@ -4886,6 +4978,7 @@ Var
 
 begin
   B:=FTest33.AsBoolean;
+  AssertTrue(B in [true,False])
 end;
 
 procedure TTestParserVariables.TestVariable33;
@@ -4947,6 +5040,12 @@ begin
   Result.resFloat:=Args[0].resFloat;
 end;
 
+Procedure EchoCurrency(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
+
+begin
+  Result.resCurrency:=Args[0].resCurrency;
+end;
+
 Procedure EchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 
 begin
@@ -4977,6 +5076,12 @@ begin
   Result.resFloat:=Args[0].resFloat;
 end;
 
+Procedure TTestExpressionParser.DoEchoCurrency(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
+
+begin
+  Result.resCurrency:=Args[0].resCurrency;
+end;
+
 Procedure TTestExpressionParser.DoEchoString(Var Result : TFPExpressionResult; Const Args : TExprParameterArray);
 
 begin
@@ -5011,6 +5116,7 @@ begin
     rtString   : res.ResString:=FP.Identifiers[0].AsString;
     rtInteger  : Res.ResInteger:=FP.Identifiers[0].AsInteger;
     rtFloat    : Res.ResFloat:=FP.Identifiers[0].AsFloat;
+    rtCurrency : Res.ResCurrency:=FP.Identifiers[0].AsCurrency;
     rtDateTime : Res.ResDateTime:=FP.Identifiers[0].AsDateTime;
   end;
 end;
@@ -5027,6 +5133,7 @@ begin
     rtString   : FP.Identifiers[0].AsString:=res.ResString;
     rtInteger  : FP.Identifiers[0].AsInteger:=Res.ResInteger;
     rtFloat    : FP.Identifiers[0].AsFloat:=Res.ResFloat;
+    rtCurrency : FP.Identifiers[0].AsCurrency:=Res.ResCurrency;
     rtDateTime : FP.Identifiers[0].AsDateTime:=Res.ResDateTime;
   end;
 end;
@@ -5119,6 +5226,24 @@ begin
   AssertException('No write access',EExprParser,@TryWrite);
 end;
 
+procedure TTestParserFunctions.TestFunction30;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
+  AssertEquals('List is dirty',True,FP.Dirty);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FP.Identifiers.Count);
+  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
+  AssertEquals('Function has correct resulttype',rtCurrency,I.ResultType);
+  AssertSame('Function has correct address',Pointer(@EchoCurrency),Pointer(I.OnGetFunctionValueCallBack));
+  FaccessAs:=rtCurrency;
+  AssertException('No read access',EExprParser,@TryRead);
+  AssertException('No write access',EExprParser,@TryWrite);
+end;
+
 procedure TTestParserFunctions.TestFunction6;
 
 Var
@@ -5197,6 +5322,21 @@ begin
 //  AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
 end;
 
+procedure TTestParserFunctions.TestFunction31;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@DoEchoCurrency);
+  AssertEquals('List is dirty',True,FP.Dirty);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FP.Identifiers.Count);
+  AssertSame('Result equals variable added',I,FP.Identifiers[0]);
+  AssertEquals('Function has correct resulttype',rtCurrency,I.ResultType);
+//  AssertSame('Function has correct address',Pointer(@EchoFloat),Pointer(I.OnGetFunctionValueCallBack));
+end;
+
 procedure TTestParserFunctions.TestFunction11;
 
 Var
@@ -5221,6 +5361,7 @@ Var
 begin
   D:=Date;
   I:=FP.Identifiers.AddFunction('Date','D','',@GetDate);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='Date';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
@@ -5237,7 +5378,9 @@ Var
 begin
   D:=Date;
   I:=FP.Identifiers.AddDateTimeVariable('a',D);
+  AssertNotNull('Addvariable returns result',I);
   I:=FP.Identifiers.AddFunction('EchoDate','D','D',@EchoDate);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='EchoDate(a)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
@@ -5248,11 +5391,10 @@ end;
 procedure TTestParserFunctions.TestFunction14;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@EchoInteger);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='EchoInteger(13)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
@@ -5263,11 +5405,10 @@ end;
 procedure TTestParserFunctions.TestFunction15;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@EchoBoolean);
+  AssertNotNull('Addvariable returns result',I);
   FP.Expression:='EchoBoolean(True)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
@@ -5278,11 +5419,10 @@ end;
 procedure TTestParserFunctions.TestFunction16;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@EchoFloat);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoFloat(1.234)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
@@ -5290,14 +5430,47 @@ begin
   AssertResult(1.234);
 end;
 
-procedure TTestParserFunctions.TestFunction17;
+procedure TTestParserFunctions.TestFunction32;
+
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  // Note there will be an implicit conversion float-> currency as the const will be a float
+  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
+  AssertNotNull('Have identifier',I);
+  FP.Expression:='EchoCurrency(1.234)';
+  AssertNotNull('Have result node',FP.ExprNode);
+  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
+  AssertResultType(rtCurrency);
+  AssertCurrencyResult(1.234);
+end;
+
+procedure TTestParserFunctions.TestFunction33;
+Var
+  I : TFPExprIdentifierDef;
+
+begin
+  // Note there will be no conversion
+  I:=FP.Identifiers.AddCurrencyVariable('a',1.234);
+  AssertNotNull('Have identifier',I);
+  I:=FP.Identifiers.AddFunction('EchoCurrency','C','C',@EchoCurrency);
+  AssertNotNull('Have identifier',I);
+  FP.Expression:='EchoCurrency(a)';
+  AssertNotNull('Have result node',FP.ExprNode);
+  AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
+  AssertResultType(rtCurrency);
+  AssertCurrencyResult(1.234);
+end;
+
+procedure TTestParserFunctions.TestFunction17;
+
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoString','S','S',@EchoString);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoString(''Aloha'')';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionCallBack, FP.ExprNode);
@@ -5315,7 +5488,9 @@ Var
 begin
   D:=Date;
   I:=FP.Identifiers.AddDateTimeVariable('a',D);
+  AssertNotNull('Have identifier',I);
   I:=FP.Identifiers.AddFunction('EchoDate','D','D',@DoEchoDate);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoDate(a)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
@@ -5326,11 +5501,10 @@ end;
 procedure TTestParserFunctions.TestFunction19;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoInteger','I','I',@DoEchoInteger);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoInteger(13)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
@@ -5341,11 +5515,10 @@ end;
 procedure TTestParserFunctions.TestFunction20;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoBoolean','B','B',@DoEchoBoolean);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoBoolean(True)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
@@ -5356,11 +5529,10 @@ end;
 procedure TTestParserFunctions.TestFunction21;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoFloat','F','F',@DoEchoFloat);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoFloat(1.234)';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
@@ -5371,11 +5543,10 @@ end;
 procedure TTestParserFunctions.TestFunction22;
 Var
   I : TFPExprIdentifierDef;
-  D : TDateTime;
 
 begin
-  D:=Date;
   I:=FP.Identifiers.AddFunction('EchoString','S','S',@DoEchoString);
+  AssertNotNull('Have identifier',I);
   FP.Expression:='EchoString(''Aloha'')';
   AssertNotNull('Have result node',FP.ExprNode);
   AssertNodeType('Constant expression',TFPFunctionEventHandler, FP.ExprNode);
@@ -5392,6 +5563,7 @@ Var
 begin
   D:=Date;
   I:=FP.Identifiers.AddFunction('Date','D','',@DoGetDate);
+  AssertNotNull('Have identifier',I);
   AssertEquals('List is dirty',True,FP.Dirty);
   AssertNotNull('Addvariable returns result',I);
   AssertEquals('One variable added',1,FP.Identifiers.Count);
@@ -5411,8 +5583,8 @@ Var
 
 begin
   I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
+  AssertNotNull('Have identifier',I);
   AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
   AssertEquals('One variable added',1,FP.Identifiers.Count);
   AssertSame('Result equals variable added',I,FP.Identifiers[0]);
   AssertEquals('Function has correct resulttype',rtInteger,I.ResultType);
@@ -5431,7 +5603,7 @@ Var
 begin
   I:=FP.Identifiers.AddFunction('Delete','S','SII',@DoDeleteString);
   AssertEquals('List is dirty',True,FP.Dirty);
-  AssertNotNull('Addvariable returns result',I);
+  AssertNotNull('Have identifier',I);
   AssertEquals('One variable added',1,FP.Identifiers.Count);
   AssertSame('Result equals variable added',I,FP.Identifiers[0]);
   AssertEquals('Function has correct resulttype',rtString,I.ResultType);
@@ -5507,6 +5679,7 @@ Var
 begin
   // Test type mismatch
   I:=FP.Identifiers.AddFunction('AddInteger','I','II',@DoAddInteger);
+  AssertNotNull('Addvariable returns result',I);
   TestParser('AddInteger(3 and 2,''s'')');
 end;
 
@@ -5589,6 +5762,21 @@ begin
   AssertEquals('Variable has correct value',FloatToStr(1.23),I.Value);
 end;
 
+procedure TTestBuiltinsManager.TestVariable7;
+
+Var
+  I : TFPBuiltinExprIdentifierDef;
+
+begin
+  I:=FM.AddCurrencyVariable(bcUser,'a',1.23);
+  AssertNotNull('Addvariable returns result',I);
+  AssertEquals('One variable added',1,FM.IdentifierCount);
+  AssertSame('Result equals variable added',I,FM.Identifiers[0]);
+  AssertEquals('Variable has correct category',ord(bcUser),Ord(I.Category));
+  AssertEquals('Variable has correct resulttype',rtCurrency,I.ResultType);
+  AssertEquals('Variable has correct value',CurrToStr(1.23),I.Value);
+end;
+
 procedure TTestBuiltinsManager.TestVariable5;
 
 Var
@@ -5786,6 +5974,21 @@ begin
   AssertResult(AResult);
 end;
 
+procedure TTestBuiltins.AssertAggregateCurrExpression(Const AExpression : String; AResult : Currency; 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;
+  AssertCurrencyResult(AResult);
+end;
+
 procedure TTestBuiltins.TestRegister;
 
 begin
@@ -6314,9 +6517,21 @@ end;
 procedure TTestBuiltins.TestFunctionAggregateSum;
 begin
   FP.Identifiers.AddIntegerVariable('S',2);
+  AssertAggregateExpression('sum(S)',10,5);
+end;
+
+procedure TTestBuiltins.TestFunctionAggregateSumFloat;
+begin
+  FP.Identifiers.AddFloatVariable('S',2.0);
   AssertAggregateExpression('sum(S)',10.0,5);
 end;
 
+procedure TTestBuiltins.TestFunctionAggregateSumCurrency;
+begin
+  FP.Identifiers.AddCurrencyVariable('S',2.0);
+  AssertAggregateCurrExpression('sum(S)',Currency(10.0),5);
+end;
+
 procedure TTestBuiltins.TestFunctionAggregateCount;
 begin
   AssertAggregateExpression('count',5,5);
@@ -6796,7 +7011,7 @@ end;
 
 initialization
 
-  RegisterTests([TTestExpressionScanner, TTestDestroyNode,
+  RegisterTests('ExprPars',[TTestExpressionScanner, TTestDestroyNode,
                  TTestConstExprNode,TTestNegateExprNode,
                  TTestBinaryAndNode,TTestBinaryOrNode,TTestBinaryXOrNode,
                  TTestNotNode,TTestEqualNode,TTestUnEqualNode,