* fcl-db: dbase/bufdataset expression parser: allow negative integers/large integers/floats; fixes issue #25168

git-svn-id: trunk@25783 -

packages/fcl-db/src/dbase/dbf_prscore.pas

@@ -112,7 +112,7 @@ type
 
 
 //--Expression functions-----------------------------------------------------
-//I: integer; L: Long Integer
+//I: Integer; L: Large Integer (Int64); F: Double; S: String; B: Boolean
 
 procedure FuncFloatToStr(Param: PExpressionRec);
 procedure FuncIntToStr_Gen(Param: PExpressionRec; Val: {$ifdef SUPPORT_INT64}Int64{$else}Integer{$endif});
@@ -124,6 +124,11 @@ procedure FuncDateToStr(Param: PExpressionRec);
 procedure FuncSubString(Param: PExpressionRec);
 procedure FuncUppercase(Param: PExpressionRec);
 procedure FuncLowercase(Param: PExpressionRec);
+procedure FuncNegative_F_F(Param: PExpressionRec);
+procedure FuncNegative_I_I(Param: PExpressionRec);
+{$ifdef SUPPORT_INT64}
+procedure FuncNegative_L_L(Param: PExpressionRec);
+{$endif}
 procedure FuncAdd_F_FF(Param: PExpressionRec);
 procedure FuncAdd_F_FI(Param: PExpressionRec);
 procedure FuncAdd_F_II(Param: PExpressionRec);
@@ -490,7 +495,12 @@ begin
           case ResultType of
             etBoolean: ExprWord := TBooleanConstant.Create(EmptyStr, PBoolean(FExpResult)^);
             etFloat:   ExprWord := TFloatConstant.CreateAsDouble(EmptyStr, PDouble(FExpResult)^);
+            etInteger: ExprWord := TIntegerConstant.Create(PInteger(FExpResult)^);
+{$ifdef SUPPORT_INT64}
+            etLargeInt:ExprWord := TLargeIntegerConstant.Create(PInt64(FExpResult)^);
+{$endif}
             etString:  ExprWord := TStringConstant.Create(FExpResult);
+            else raise EparserException.CreateFmt('No support for resulttype %d. Please fix the TDBF code.',[ResultType]);
           end;
 
           // fill in structure
@@ -1425,6 +1435,26 @@ begin
   end;
 end;
 
+procedure FuncNegative_F_F(Param: PExpressionRec);
+begin
+  with Param^ do
+    PDouble(Res.MemoryPos^)^ := -PDouble(Args[0])^;
+end;
+
+procedure FuncNegative_I_I(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInteger(Res.MemoryPos^)^ := -PInteger(Args[0])^;
+end;
+
+{$ifdef SUPPORT_INT64}
+procedure FuncNegative_L_L(Param: PExpressionRec);
+begin
+  with Param^ do
+    PInt64(Res.MemoryPos^)^ := -PInt64(Args[0])^;
+end;
+{$endif}
+
 procedure FuncAdd_F_FF(Param: PExpressionRec);
 begin
   with Param^ do
@@ -2169,6 +2199,11 @@ initialization
     // operators - name, param types, result type, func addr, precedence
     // note that the parameter types in the second column must match with
     // the function signature in the function address
+    Add(TFunction.CreateOper('-@', 'I', etInteger,  FuncNegative_I_I, 20));
+    Add(TFunction.CreateOper('-@', 'F', etFloat,    FuncNegative_F_F, 20));
+{$ifdef SUPPORT_INT64}
+    Add(TFunction.CreateOper('-@', 'L', etLargeInt, FuncNegative_L_L, 20));
+{$endif}
     Add(TFunction.CreateOper('+', 'SS', etString,   nil,          40));
     Add(TFunction.CreateOper('+', 'FF', etFloat,    FuncAdd_F_FF, 40));
     Add(TFunction.CreateOper('+', 'FI', etFloat,    FuncAdd_F_FI, 40));

packages/fcl-db/src/dbase/dbf_prsdef.pas

@@ -200,6 +200,19 @@ type
     function AsPointer: PChar; override;
   end;
 
+{$ifdef SUPPORT_INT64}
+  { TLargeIntegerConstant }
+
+  TLargeIntegerConstant = class(TConstant)
+  private
+    FValue: Int64;
+  public
+    constructor Create(AValue: Int64);
+
+    function AsPointer: PChar; override;
+  end;
+{$endif}
+
   TBooleanConstant = class(TConstant)
   private
     FValue: Boolean;
@@ -334,8 +347,8 @@ type
   end;
 
   TVaryingFunction = class(TFunction)
-    // Functions that can vary for ex. random generators
-    // should be TVaryingFunction to be sure that they are
+    // Functions that can vary e.g. random generators
+    // should be TVaryingFunction to ensure that they are
     // always evaluated
   protected
     function GetCanVary: Boolean; override;
@@ -633,6 +646,22 @@ begin
   Result := PChar(@FValue);
 end;
 
+{$ifdef SUPPORT_INT64}
+{ TLargeIntegerConstant }
+
+constructor TLargeIntegerConstant.Create(AValue: Int64);
+begin
+  inherited Create(IntToStr(AValue), etLargeInt, _LargeIntVariable);
+
+  FValue := AValue;
+end;
+
+function TLargeIntegerConstant.AsPointer: PChar;
+begin
+  Result := PChar(@FValue);
+end;
+{$endif}
+
 { TVariable }
 
 constructor TVariable.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);

packages/fcl-db/src/dbase/history.txt

@@ -33,6 +33,7 @@ BUGS & WARNINGS
 Changelog:
 ------------------------
 FreePascal trunk (future V7.0.0): (r* referes to FPC subversion revision/commit)
+- fix some filter functions working with incorrect parameters (r25755)
 - add support for memo and index stream so no disk files are needed when using streams
 - clarification on field types; remove some workarounds (r24169) todo: reinstate depending on test set
 - initial support for (Visual) FoxPro files (r24139)