paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-07 19:50:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Patch from Laco to implement filtering on null values

Browse Source
This commit is contained in:
Michaël Van Canneyt 2022-02-15 23:32:17 +01:00
parent 0f5bd26cba
commit f1043ef099
3 changed files with 111 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
packages/fcl-db/src/base/bufdataset_parser.pp
View File

@ -65,10 +65,12 @@ type
private
FField: TField;
FFieldName: string;
FFieldIsNull: boolean;
FExprWord: TExprWord;
protected
function GetFieldVal: Pointer; virtual; abstract;
function GetFieldType: TExpressionType; virtual; abstract;
function GetFieldIsNull: PBoolean;
public
constructor Create(UseField: TField);
@ -78,6 +80,7 @@ type
property FieldDef: TField read FField;
property FieldType: TExpressionType read GetFieldType;
property FieldName: string read FFieldName;
property FieldIsNull: PBoolean read GetFieldIsNull;
end;
TStringFieldVar = class(TFieldVar)
@ -148,7 +151,6 @@ type
procedure Refresh(Buffer: TRecordBuffer); override;
end;
//--TFieldVar----------------------------------------------------------------
constructor TFieldVar.Create(UseField: TField);
begin
@ -160,6 +162,11 @@ begin
FFieldName := UseField.FieldName;
end;
function TFieldVar.GetFieldIsNull: PBoolean;
begin
Result := @FFieldIsNull;
end;
//--TStringFieldVar-------------------------------------------------------------
function TStringFieldVar.GetFieldVal: Pointer;
begin
@ -188,7 +195,8 @@ end;
procedure TStringFieldVar.Refresh(Buffer: TRecordBuffer);
var Fieldbuf : TStringFieldBuffer;
begin
if not FField.DataSet.GetFieldData(FField,@Fieldbuf) then
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@Fieldbuf);
if FFieldIsNull then
FFieldVal^:=#0
else
strcopy(FFieldVal,@Fieldbuf[0]);
@ -207,7 +215,8 @@ end;
procedure TFloatFieldVar.Refresh(Buffer: TRecordBuffer);
begin
if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
if FFieldIsNull then
FFieldVal := 0;
end;
@ -224,7 +233,8 @@ end;
procedure TIntegerFieldVar.Refresh(Buffer: TRecordBuffer);
begin
if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
if FFieldIsNull then
FFieldVal := 0;
end;
@ -241,7 +251,8 @@ end;
procedure TLargeIntFieldVar.Refresh(Buffer: TRecordBuffer);
begin
if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
if FFieldIsNull then
FFieldVal := 0;
end;
@ -258,7 +269,8 @@ end;
procedure TDateTimeFieldVar.Refresh(Buffer:TRecordBuffer );
begin
if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
if FFieldIsNull then
FFieldVal := 0;
end;
@ -275,17 +287,19 @@ end;
procedure TBooleanFieldVar.Refresh(Buffer: TRecordBuffer);
begin
if not FField.DataSet.GetFieldData(FField,@FFieldVal) then
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@FFieldVal);
if FFieldIsNull then
FFieldVal := False;
end;
procedure TBCDFieldVar.Refresh(Buffer: TRecordBuffer);
var c: currency;
begin
if FField.DataSet.GetFieldData(FField,@c) then
FFieldVal := c
FFieldIsNull := not FField.DataSet.GetFieldData(FField,@c);
if FFieldIsNull then
FFieldVal := 0
else
FFieldVal := 0;
FFieldVal := c;
end;
@ -390,7 +404,7 @@ begin
ftString, ftFixedChar:
begin
TempFieldVar := TStringFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal);
TempFieldVar.FExprWord := DefineStringVariable(VarName, TempFieldVar.FieldVal, TempFieldVar.FieldIsNull);
TempFieldVar.FExprWord.fixedlen := Fieldinfo.Size;
end;
ftBoolean:
@ -406,7 +420,7 @@ begin
ftAutoInc, ftInteger, ftSmallInt, ftWord:
begin
TempFieldVar := TIntegerFieldVar.Create(FieldInfo);
TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal);
TempFieldVar.FExprWord := DefineIntegerVariable(VarName, TempFieldVar.FieldVal, TempFieldVar.FieldIsNull);
end;
ftLargeInt:
begin

37
packages/fcl-db/src/dbase/dbf_prscore.pas
View File

@ -85,14 +85,14 @@ type
destructor Destroy; override;
function DefineFloatVariable(AVarName: string; AValue: PDouble): TExprWord;
function DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
function DefineIntegerVariable(AVarName: string; AValue: PInteger; AIsNull: PBoolean = nil): TExprWord;
// procedure DefineSmallIntVariable(AVarName: string; AValue: PSmallInt);
{$ifdef SUPPORT_INT64}
function DefineLargeIntVariable(AVarName: string; AValue: PLargeInt): TExprWord;
{$endif}
function DefineDateTimeVariable(AVarName: string; AValue: PDateTimeRec): TExprWord;
function DefineBooleanVariable(AVarName: string; AValue: PBoolean): TExprWord;
function DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
function DefineStringVariable(AVarName: string; AValue: PPChar; AIsNull: PBoolean = nil): TExprWord;
function DefineFunction(AFunctName, AShortName, ADescription, ATypeSpec: string;
AMinFunctionArg: Integer; AResultType: TExpressionType; AFuncAddress: TExprFunc): TExprWord;
procedure Evaluate(AnExpression: string);
@ -265,6 +265,8 @@ begin
Args[0] := ExprWord.AsPointer;
// store length as second parameter
Args[1] := PChar(ExprWord.LenAsPointer);
// and NULL indicator as third parameter
Args[2] := PChar(ExprWord.IsNullAsPointer);
end;
end;
end;
@ -501,6 +503,7 @@ begin
etLargeInt:ExprWord := TLargeIntConstant.Create(PInt64(FExpResult)^);
{$endif}
etString: ExprWord := TStringConstant.Create(FExpResult);
etUnknown: ExprWord := TNullConstant.Create;
else raise EParserException.CreateFmt('No support for resulttype %d. Please fix the TDBF code.',[ResultType]);
end;
@ -778,6 +781,8 @@ begin
end;
procedure TCustomExpressionParser.ParseString(AnExpression: string; DestCollection: TExprCollection);
const
NullWord='NULL';
var
isConstant: Boolean;
I, I1, I2, Len, DecSep: Integer;
@ -971,6 +976,13 @@ begin
DestCollection.Add(TempWord);
FConstantsList.Add(TempWord);
end
else if UpCase(W) = NullWord then
begin
// NULL
TempWord := TNullConstant.Create;
DestCollection.Add(TempWord);
FConstantsList.Add(TempWord);
end
else if Length(W) > 0 then
if FWordsList.Search(PChar(W), I) then
begin
@ -1132,9 +1144,9 @@ begin
FWordsList.Add(Result);
end;
function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger): TExprWord;
function TCustomExpressionParser.DefineIntegerVariable(AVarName: string; AValue: PInteger; AIsNull: PBoolean): TExprWord;
begin
Result := TIntegerVariable.Create(AVarName, AValue);
Result := TIntegerVariable.Create(AVarName, AValue, AIsNull);
FWordsList.Add(Result);
end;
@ -1166,9 +1178,9 @@ begin
FWordsList.Add(Result);
end;
function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar): TExprWord;
function TCustomExpressionParser.DefineStringVariable(AVarName: string; AValue: PPChar; AIsNull: PBoolean): TExprWord;
begin
Result := TStringVariable.Create(AVarName, AValue);
Result := TStringVariable.Create(AVarName, AValue, AIsNull);
FWordsList.Add(Result);
end;
@ -1864,6 +1876,12 @@ begin
Res.MemoryPos^^ := Char(AnsiStrComp(Args[0], Args[1]) >= 0);
end;
procedure Func_SU_EQ(Param: PExpressionRec);
begin
with Param^ do
Res.MemoryPos^^ := Char(PBoolean(Args[0]+StrLen(Args[0])+1)^);
end;
procedure Func_FF_EQ(Param: PExpressionRec);
begin
with Param^ do
@ -1941,6 +1959,11 @@ begin
with Param^ do
Res.MemoryPos^^ := Char(PInteger(Args[0])^ = PInteger(Args[1])^);
end;
procedure Func_IU_EQ(Param: PExpressionRec);
begin
with Param^ do
Res.MemoryPos^^ := Char(PBoolean(Args[0]+8)^);
end;
procedure Func_II_NEQ(Param: PExpressionRec);
begin
@ -2294,6 +2317,7 @@ initialization
Add(TFunction.CreateOper('>=','FI', etBoolean, Func_FI_GTE, 80));
Add(TFunction.CreateOper('<>','FI', etBoolean, Func_FI_NEQ, 80));
Add(TFunction.CreateOper('=', 'II', etBoolean, Func_II_EQ , 80));
Add(TFunction.CreateOper('=', 'IU', etBoolean, Func_IU_EQ , 80));
Add(TFunction.CreateOper('<', 'II', etBoolean, Func_II_LT , 80));
Add(TFunction.CreateOper('>', 'II', etBoolean, Func_II_GT , 80));
Add(TFunction.CreateOper('<=','II', etBoolean, Func_II_LTE, 80));
@ -2337,6 +2361,7 @@ initialization
Add(TFunction.CreateOper('>=','IL', etBoolean, Func_IL_GTE, 80));
Add(TFunction.CreateOper('<>','IL', etBoolean, Func_IL_NEQ, 80));
{$endif}
Add(TFunction.CreateOper('=', 'SU', etBoolean, Func_SU_EQ , 80));
Add(TFunction.CreateOper('NOT', 'B', etBoolean, Func_NOT, 85));
Add(TFunction.CreateOper('AND', 'BB', etBoolean, Func_AND, 90));

62
packages/fcl-db/src/dbase/dbf_prsdef.pas
View File

@ -90,6 +90,8 @@ type
ExprFunc: TExprFunc;
end;
{ TExprWord }
TExprWord = class(TObject)
private
FName: string;
@ -112,8 +114,9 @@ type
public
constructor Create(AName: string; AExprFunc: TExprFunc);
function LenAsPointer: PInteger; virtual;
function AsPointer: PChar; virtual;
function LenAsPointer: PInteger; virtual;
function IsNullAsPointer: PBoolean; virtual;
function IsFunction: Boolean; virtual;
property ExprFunc: TExprFunc read FExprFunc;
@ -225,14 +228,26 @@ type
property Value: Boolean read FValue write FValue;
end;
{ TNullConstant }
TNullConstant = class(TConstant)
private
public
constructor Create;
end;
{ TVariable }
TVariable = class(TExprWord)
private
FResultType: TExpressionType;
FIsNull: PBoolean;
protected
function GetCanVary: Boolean; override;
function GetResultType: TExpressionType; override;
public
constructor Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
function IsNullAsPointer: PBoolean; override;
end;
TFloatVariable = class(TVariable)
@ -252,7 +267,7 @@ type
function GetFixedLen: Integer; override;
procedure SetFixedLen(NewLen: integer); override;
public
constructor Create(AName: string; AValue: PPChar);
constructor Create(AName: string; AValue: PPChar; AIsNull: PBoolean);
function LenAsPointer: PInteger; override;
function AsPointer: PChar; override;
@ -273,7 +288,7 @@ type
private
FValue: PInteger;
public
constructor Create(AName: string; AValue: PInteger);
constructor Create(AName: string; AValue: PInteger; AIsNull: PBoolean);
function AsPointer: PChar; override;
end;
@ -372,6 +387,7 @@ begin
'F': Result := etFloat;
'D': Result := etDateTime;
'S': Result := etString;
'U': Result := etUnknown;
else
Result := etUnknown;
end;
@ -405,6 +421,10 @@ begin
if length = -1 then
length := StrLen(PPChar(Args[0])^);
Res.Append(PPChar(Args[0])^, length);
// NULL indicator (placed after NULL terminated string)
length := StrLen(PPChar(Args[0])^)+1;
Res.AssureSpace(length+1);
PBoolean(Res.Memory^+length)^ := Assigned(Args[2]) and PBoolean(Args[2])^;
end;
end;
@ -416,8 +436,10 @@ end;
procedure _IntegerVariable(Param: PExpressionRec);
begin
with Param^ do
with Param^ do begin
PInteger(Res.MemoryPos^)^ := PInteger(Args[0])^;
PBoolean(Res.MemoryPos^+8)^ := Assigned(Args[2]) and PBoolean(Args[2])^; // NULL indicator
end;
end;
{
@ -429,15 +451,18 @@ end;
}
{$ifdef SUPPORT_INT64}
procedure _LargeIntVariable(Param: PExpressionRec);
begin
with Param^ do
PLargeInt(Res.MemoryPos^)^ := PLargeInt(Args[0])^;
end;
{$endif}
procedure _NullConstant(Param: PExpressionRec);
begin
// NOP
end;
{ TExpressionWord }
constructor TExprWord.Create(AName: string; AExprFunc: TExprFunc);
@ -536,6 +561,11 @@ begin
Result := nil;
end;
function TExprWord.IsNullAsPointer: PBoolean;
begin
Result := nil;
end;
function TExprWord.IsFunction: Boolean;
begin
Result := False;
@ -665,6 +695,13 @@ begin
end;
{$endif}
{ TNullConstant }
constructor TNullConstant.Create;
begin
inherited Create('NULL', etUnknown, _NullConstant);
end;
{ TVariable }
constructor TVariable.Create(AName: string; AVarType: TExpressionType; AExprFunc: TExprFunc);
@ -684,6 +721,11 @@ begin
Result := FResultType;
end;
function TVariable.IsNullAsPointer: PBoolean;
begin
Result := FIsNull;
end;
{ TFloatVariable }
constructor TFloatVariable.Create(AName: string; AValue: PDouble);
@ -699,7 +741,7 @@ end;
{ TStringVariable }
constructor TStringVariable.Create(AName: string; AValue: PPChar);
constructor TStringVariable.Create(AName: string; AValue: PPChar; AIsNull: PBoolean);
begin
// variable or fixed length?
inherited Create(AName, etString, _StringVariable);
@ -707,6 +749,7 @@ begin
// store pointer to string
FValue := AValue;
FFixedLen := -1;
FIsNull := AIsNull;
end;
function TStringVariable.AsPointer: PChar;
@ -744,10 +787,11 @@ end;
{ TIntegerVariable }
constructor TIntegerVariable.Create(AName: string; AValue: PInteger);
constructor TIntegerVariable.Create(AName: string; AValue: PInteger; AIsNull: PBoolean);
begin
inherited Create(AName, etInteger, _IntegerVariable);
FValue := AValue;
FIsNull := AIsNull;
end;
function TIntegerVariable.AsPointer: PChar;
@ -1070,6 +1114,7 @@ begin
Inc(FMemoryPos^, Length);
// null-terminate
FMemoryPos^^ := #0;
Inc(FMemoryPos^);
end;
procedure TDynamicType.AppendInteger(Source: Integer);
@ -1078,6 +1123,7 @@ begin
AssureSpace(12);
Inc(FMemoryPos^, GetStrFromInt(Source, FMemoryPos^));
FMemoryPos^^ := #0;
Inc(FMemoryPos^);
end;
end.