* Set DEFAULT_ORDER if no index-name is given

 * Set the current record to the first record for all indexes when opening a dataset
 * Fixed sorting for various fieldtypes 
 * Added dependency on unit strutils now StringsReplace is moved there
 * Added several index-tests

git-svn-id: trunk@9823 -

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

@@ -175,7 +175,7 @@ type
     function LoadBuffer(Buffer : PChar): TGetResult;
     function GetFieldSize(FieldDef : TFieldDef) : longint;
     function GetRecordUpdateBuffer : boolean;
-    procedure SetIndexName(const AValue: String);
+    procedure SetIndexName(AValue: String);
 {$IFNDEF ARRAYBUF}
     procedure SetMaxIndexesCount(const AValue: Integer);
 {$ENDIF}
@@ -293,37 +293,37 @@ end;
 function DBCompareByte(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  Result := PByte(aValue)^-PByte(subValue)^;
+  Result := PByte(subValue)^-PByte(aValue)^;
 end;
 
 function DBCompareSmallInt(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  Result := PSmallInt(aValue)^-PSmallInt(subValue)^;
+  Result := PSmallInt(subValue)^-PSmallInt(aValue)^;
 end;
 
 function DBCompareInt(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  Result := PInteger(aValue)^-PInteger(subValue)^;
+  Result := PInteger(subValue)^-PInteger(aValue)^;
 end;
 
 function DBCompareLargeInt(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  Result := PInt64(aValue)^-PInt64(subValue)^;
+  Result := PInt64(subValue)^-PInt64(aValue)^;
 end;
 
 function DBCompareWord(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  Result := PWord(aValue)^-PWord(subValue)^;
+  Result := PWord(subValue)^-PWord(aValue)^;
 end;
 
 function DBCompareQWord(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
 
 begin
-  Result := PQWord(aValue)^-PQWord(subValue)^;
+  Result := PQWord(subValue)^-PQWord(aValue)^;
 end;
 
 function DBCompareDouble(subValue, aValue: pointer; options: TLocateOptions): LargeInt;
@@ -419,8 +419,9 @@ begin
     ftBoolean : Comparefunc := @DBCompareByte;
     ftFloat : Comparefunc := @DBCompareDouble;
     ftDateTime,ftDate,ftTime : Comparefunc := @DBCompareDouble;
+    ftLargeint : Comparefunc := @DBCompareLargeInt;
   else
-    DatabaseErrorFmt(SErrIndexBasedOnInvField,[aindex.fields.Name]);
+    DatabaseErrorFmt(SErrIndexBasedOnInvField,[aindex.fields.FieldName]);
   end;
 
   PCurRecLinkItem:=FIndexes[0].FFirstRecBuf;
@@ -507,7 +508,7 @@ begin
         PlaceQRec := true
       else if (qsize=0) or (q = AIndex.FLastRecBuf) then
         PlaceQRec := False
-      else if DBCompareText(pchar(p)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AIndex.Fields.FieldNo-1],pchar(q)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AIndex.Fields.FieldNo-1],[]) <= 0 then
+      else if Comparefunc(pchar(p)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AIndex.Fields.FieldNo-1],pchar(q)+sizeof(TBufRecLinkItem)*FMaxIndexesCount+FFieldBufPositions[AIndex.Fields.FieldNo-1],[]) <= 0 then
         PlaceQRec := False
       else
         PlaceQRec := True;
@@ -890,9 +891,10 @@ begin
   Result := (FCurrentUpdateBuffer < length(FUpdateBuffer))  and CompareBuf(FCurrentUpdateBuffer);
 end;
 
-procedure TBufDataset.SetIndexName(const AValue: String);
+procedure TBufDataset.SetIndexName(AValue: String);
 var i : integer;
 begin
+  if AValue='' then AValue := 'DEFAULT_ORDER';
   for i := 0 to FIndexesCount-1 do
     if SameText(FIndexes[i].Name,AValue) then
       begin
@@ -1142,7 +1144,10 @@ begin
     Result := grEOF;
     FAllPacketsFetched := True;
     if FIndexesCount>0 then for x := 1 to FIndexesCount-1 do
+      begin
       BuildIndex(FIndexes[x]);
+      FIndexes[x].FCurrentRecBuf:=FIndexes[x].FFirstRecBuf;
+      end;
     Exit;
     end;
 

packages/fcl-db/tests/testdbbasics.pas

@@ -22,6 +22,7 @@ type
 
     procedure FTestDelete1(TestCancelUpdate : boolean);
     procedure FTestDelete2(TestCancelUpdate : boolean);
+    procedure TestAddIndexFieldType(AFieldType : TFieldType; ActiveDS : boolean);
   protected
     procedure SetUp; override;
     procedure TearDown; override;
@@ -38,6 +39,19 @@ type
     procedure TestStringFilter;
 
     procedure TestAddIndex;
+    procedure TestInactSwitchIndex;
+
+    procedure TestAddIndexInteger;
+    procedure TestAddIndexSmallInt;
+    procedure TestAddIndexBoolean;
+    procedure TestAddIndexFloat;
+    procedure TestAddIndexLargeInt;
+    procedure TestAddIndexDateTime;
+    procedure TestAddIndexCurrency;
+    procedure TestAddIndexBCD;
+
+    procedure TestAddIndexActiveDS;
+    procedure TestAddIndexEditDS;
 
     procedure TestNullAtOpen;
 
@@ -783,28 +797,212 @@ begin
     end;
 end;
 
+procedure TTestDBBasics.TestAddIndexFieldType(AFieldType: TFieldType; ActiveDS : boolean);
+var ds : TBufDataset;
+    FList : TStringList;
+    LastValue : Variant;
+begin
+  ds := DBConnector.GetFieldDataset as TBufDataset;
+  with ds do
+    begin
+    
+    if not ActiveDS then
+      begin
+      AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+      IndexName:='testindex';
+      end
+    else
+      MaxIndexesCount := 3;
+
+    try
+      open;
+    except
+      if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
+        Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset')
+      else
+        raise;
+    end;
+
+    if ActiveDS then
+      begin
+      if not assigned(ds.FindField('F'+FieldTypeNames[AfieldType])) then
+        Ignore('Fields of the type ' + FieldTypeNames[AfieldType] + ' are not supported by this type of dataset');
+      AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+      IndexName:='testindex';
+      First;
+      end;
+
+    LastValue:=null;
+    while not eof do
+      begin
+      AssertTrue(LastValue<=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant);
+      LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
+      Next;
+      end;
+
+    while not bof do
+      begin
+      AssertTrue(LastValue>=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant);
+      LastValue:=FieldByName('F'+FieldTypeNames[AfieldType]).AsVariant;
+      Prior;
+      end;
+    end;
+end;
+
+procedure TTestDBBasics.TestAddIndexSmallInt;
+begin
+  TestAddIndexFieldType(ftSmallint,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexBoolean;
+begin
+  TestAddIndexFieldType(ftBoolean,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexFloat;
+begin
+  TestAddIndexFieldType(ftFloat,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexInteger;
+begin
+  TestAddIndexFieldType(ftInteger,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexLargeInt;
+begin
+  TestAddIndexFieldType(ftLargeint,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexDateTime;
+begin
+  TestAddIndexFieldType(ftDateTime,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexCurrency;
+begin
+  TestAddIndexFieldType(ftCurrency,False);
+end;
+
+procedure TTestDBBasics.TestAddIndexBCD;
+begin
+  TestAddIndexFieldType(ftBCD,False);
+end;
+
 procedure TTestDBBasics.TestAddIndex;
-var ds   : TBufDataset;
-    I    : integer;
+var ds : TBufDataset;
+    AFieldType : TFieldType;
+    FList : TStringList;
+    i : integer;
 begin
-  ds := DBConnector.GetNDataset(5) as TBufDataset;
+  ds := DBConnector.GetFieldDataset as TBufDataset;
   with ds do
     begin
-    i:=5;
 
+    AFieldType:=ftString;
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+    FList := TStringList.Create;
+    FList.Sorted:=true;
+    FList.CaseSensitive:=True;
+    FList.Duplicates:=dupAccept;
     open;
-    
-//    AddSecondIndex;
 
     while not eof do
       begin
-      AssertEquals(i,fields[0].AsInteger);
+      flist.Add(FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
       Next;
+      end;
+
+    IndexName:='testindex';
+    first;
+    i:=0;
+
+    while not eof do
+      begin
+      AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      inc(i);
+      Next;
+      end;
+
+    while not bof do
+      begin
       dec(i);
+      AssertEquals(flist[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      Prior;
+      end;
+    end;
+end;
+
+procedure TTestDBBasics.TestInactSwitchIndex;
+// Test if the default-index is properly build when the active index is not
+// the default-index while opening then dataset
+var ds : TBufDataset;
+    AFieldType : TFieldType;
+    i : integer;
+begin
+  ds := DBConnector.GetFieldDataset as TBufDataset;
+  with ds do
+    begin
+
+    AFieldType:=ftString;
+    AddIndex('testindex','F'+FieldTypeNames[AfieldType]);
+    IndexName:='testindex';
+    open;
+    IndexName:=''; // This should set the default index (default_order)
+    first;
+    
+    i := 0;
+
+    while not eof do
+      begin
+      AssertEquals(testStringValues[i],FieldByName('F'+FieldTypeNames[AfieldType]).AsString);
+      inc(i);
+      Next;
       end;
     end;
 end;
 
+procedure TTestDBBasics.TestAddIndexActiveDS;
+var ds   : TBufDataset;
+    I    : integer;
+begin
+  TestAddIndexFieldType(ftString,true);
+end;
+
+procedure TTestDBBasics.TestAddIndexEditDS;
+var ds        : TBufDataset;
+    I         : integer;
+    LastValue : String;
+begin
+  ds := DBConnector.GetNDataset(True,5) as TBufDataset;
+  with ds do
+    begin
+    MaxIndexesCount:=3;
+    open;
+    edit;
+    FieldByName('name').asstring := 'Zz';
+    post;
+    next;
+    next;
+    edit;
+    FieldByName('name').asstring := 'aA';
+    post;
+
+    AddIndex('test','name');
+
+    first;
+    ds.IndexName:='test';
+    first;
+    LastValue:=FieldByName('name').AsString;
+    while not eof do
+      begin
+      AssertTrue(LastValue<=FieldByName('name').AsString);
+      Next;
+      end;
+    end;
+end;
+
+
 procedure TTestDBBasics.TestcalculatedField_OnCalcfields(DataSet: TDataSet);
 begin
   case dataset.fieldbyname('ID').asinteger of

packages/fcl-db/tests/testsqlfieldtypes.pas

@@ -74,7 +74,7 @@ type
 
 implementation
 
-uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset;
+uses sqldbtoolsunit,toolsunit, variants, sqldb, bufdataset, strutils;
 
 Type HackedDataset = class(TDataset);