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

git-svn-id: trunk@15203 -

packages/fcl-db/src/base/bufdataset.pas

@@ -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);

packages/fcl-db/tests/testfieldtypes.pas

@@ -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;