paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 18:29:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Proper checks for null-values when comparing fields + tests

Browse Source 
git-svn-id: trunk@15203 -
This commit is contained in:
joost 2010-05-02 14:30:32 +00:00
parent 0b44f8db1f
commit f9616640d8
2 changed files with 83 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
packages/fcl-db/src/base/bufdataset.pas
View File

@ -99,6 +99,10 @@ type
TDBCompareRec = record
Comparefunc : TCompareFunc;
Off1,Off2 : PtrInt;
FieldInd1,
FieldInd2 : longint;
NullBOff1,
NullBOff2 : PtrInt;
Options : TLocateOptions;
Desc : Boolean;
end;
@ -605,21 +609,6 @@ begin
result := 0;
end;
function IndexCompareRecords(Rec1,Rec2 : pointer; ADBCompareRecs : TDBCompareStruct) : LargeInt;
var IndexFieldNr : Integer;
begin
for IndexFieldNr:=0 to length(ADBCompareRecs)-1 do with ADBCompareRecs[IndexFieldNr] do
begin
Result := Comparefunc(Rec1+Off1,Rec2+Off2,Options);
if Result <> 0 then
begin
if Desc then
Result := -Result;
break;
end;
end;
end;
procedure unSetFieldIsNull(NullMask : pbyte;x : longint); //inline;
begin
NullMask[x div 8] := (NullMask[x div 8]) and not (1 shl (x mod 8));
@ -635,6 +624,32 @@ begin
result := ord(NullMask[x div 8]) and (1 shl (x mod 8)) > 0
end;
function IndexCompareRecords(Rec1,Rec2 : pointer; ADBCompareRecs : TDBCompareStruct) : LargeInt;
var IndexFieldNr : Integer;
IsNull1, IsNull2 : boolean;
begin
for IndexFieldNr:=0 to length(ADBCompareRecs)-1 do with ADBCompareRecs[IndexFieldNr] do
begin
IsNull1:=GetFieldIsNull(rec1+NullBOff1,FieldInd1);
IsNull2:=GetFieldIsNull(rec2+NullBOff2,FieldInd2);
if IsNull1 and IsNull2 then
result := 0
else if IsNull1 then
result := -1
else if IsNull2 then
result := 1
else
Result := Comparefunc(Rec1+Off1,Rec2+Off2,Options);
if Result <> 0 then
begin
if Desc then
Result := -Result;
break;
end;
end;
end;
{ ---------------------------------------------------------------------
TCustomBufDataset
---------------------------------------------------------------------}
@ -1349,6 +1364,12 @@ begin
ACompareRec.Off1:=sizeof(TBufRecLinkItem)*FMaxIndexesCount+
FFieldBufPositions[AField.FieldNo-1];
ACompareRec.Off2:=ACompareRec.Off1;
ACompareRec.FieldInd1:=AField.FieldNo-1;
ACompareRec.FieldInd2:=ACompareRec.FieldInd1;
ACompareRec.NullBOff1:=sizeof(TBufRecLinkItem)*MaxIndexesCount;
ACompareRec.NullBOff2:=ACompareRec.NullBOff1;
end;
procedure TCustomBufDataset.SetIndexFieldNames(const AValue: String);

47
packages/fcl-db/tests/testfieldtypes.pas
View File

@ -39,6 +39,8 @@ type
procedure TestLimitQuery; // bug 15456
procedure Test11Params;
procedure TestRowsAffected; // bug 9758
procedure TestLocateNull;
procedure TestLocateOnMoreRecords;
procedure TestStringsReplace;
procedure TestCircularParams;
procedure TestBug9744;
@ -927,6 +929,51 @@ begin
inherited RunTest;
end;
procedure TTestFieldTypes.TestLocateNull;
var DS: TCustomBufDataset;
begin
ds := TSQLDBConnector(DBConnector).GetNDataset(true,5) as TCustomBufDataset;
with ds do
begin
open;
edit;
fieldbyname('name').Clear;
post;
next;
AssertFalse(Locate('name',VarArrayOf(['TestName1']),[]));
AssertTrue(Locate('name',VarArrayOf([Null]),[]));
AssertEquals(1,fieldbyname('ID').AsInteger);
end;
end;
procedure TTestFieldTypes.TestLocateOnMoreRecords;
var DS: TCustomBufDataset;
begin
with TSQLDBConnector(DBConnector) do
begin
ds := GetNDataset(true,30) as TCustomBufDataset;
with query do
begin
SQL.Text:='update FPDEV set NAME = null where ID<11;';
ExecSQL;
SQL.Text:='update FPDEV set NAME = null where (ID>11) and (ID<23);';
ExecSQL;
end;
with ds do
begin
Open;
// Must be exactly 11 to trigger bug/test
AssertTrue(Locate('name',VarArrayOf(['TestName11']),[]));
AssertEquals(11,fieldbyname('ID').AsInteger);
// Must be exactly 23 to trigger bug/test
AssertTrue(Locate('name',VarArrayOf(['TestName23']),[]));
AssertEquals(23,fieldbyname('ID').AsInteger);
end;
end;
end;
procedure TTestFieldTypes.TestRefresh;
var ADataset: TDataset;
i: integer;