From 46bdee3f528a29b647d3188285c832e79f514ebf Mon Sep 17 00:00:00 2001 From: reiniero Date: Mon, 14 Oct 2013 17:09:45 +0000 Subject: [PATCH] * 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 | 37 ++++++++++++++++++++++- packages/fcl-db/src/dbase/dbf_prsdef.pas | 33 ++++++++++++++++++-- packages/fcl-db/src/dbase/history.txt | 1 + 3 files changed, 68 insertions(+), 3 deletions(-) diff --git a/packages/fcl-db/src/dbase/dbf_prscore.pas b/packages/fcl-db/src/dbase/dbf_prscore.pas index 0c2aaf864f..0c5c817d55 100644 --- a/packages/fcl-db/src/dbase/dbf_prscore.pas +++ b/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)); diff --git a/packages/fcl-db/src/dbase/dbf_prsdef.pas b/packages/fcl-db/src/dbase/dbf_prsdef.pas index 6605b44700..467c1cbdfd 100644 --- a/packages/fcl-db/src/dbase/dbf_prsdef.pas +++ b/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); diff --git a/packages/fcl-db/src/dbase/history.txt b/packages/fcl-db/src/dbase/history.txt index a2b6273d56..e2bb9380ac 100644 --- a/packages/fcl-db/src/dbase/history.txt +++ b/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)