fcl-db: bufdataset: when new record is inserted or existing edited and some sorted index is presented record is moved to proper position in index. (introduces OrderCurrentRecord method). Small drawback is than in case of inserting record new record is first inserted before current record and then moved to proper position.(but it takes only few memory operations in current implementation).

Bug #23465

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@23592 3ad0048d-3df7-0310-abae-a5850022a9f2

2 files changed, 53 insertions, 12 deletions

diff --git a/packages/fcl-db/src/base/bufdataset.pas b/packages/fcl-db/src/base/bufdataset.pas
index 4326dd7802..6978692436 100644
--- a/packages/fcl-db/src/base/bufdataset.pas
+++ b/packages/fcl-db/src/base/bufdataset.pas
@@ -161,14 +161,14 @@ type
     // Inserts a record before the current record, or if the record is sorted,
     // inserts it in the proper position
     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); virtual; abstract;
+    procedure OrderCurrentRecord; virtual; abstract;
     procedure EndUpdate; virtual; abstract;
     
     procedure RemoveRecordFromIndex(const ABookmark : TBufBookmark); virtual; abstract;
-    
+
     function CompareBookmarks(const ABookmark1, ABookmark2 : PBufBookmark) : boolean; virtual;
     Function GetRecNo(const ABookmark : PBufBookmark) : integer; virtual; abstract;
 
-
     property SpareRecord : TRecordBuffer read GetSpareRecord;
     property SpareBuffer : TRecordBuffer read GetSpareBuffer;
     property CurrentRecord : TRecordBuffer read GetCurrentRecord;
@@ -228,6 +228,7 @@ type
     procedure BeginUpdate; override;
     procedure AddRecord; override;
     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
+    procedure OrderCurrentRecord; override;
     procedure EndUpdate; override;
   end;
 
@@ -273,6 +274,7 @@ type
     procedure BeginUpdate; override;
     procedure AddRecord; override;
     procedure InsertRecordBeforeCurrentRecord(Const ARecord : TRecordBuffer); override;
+    procedure OrderCurrentRecord; override;
     procedure EndUpdate; override;
   end;
 
@@ -1466,6 +1468,37 @@ begin
   ANewRecord[IndNr].next[IndNr].prior:=ANewRecord;
 end;
 
+procedure TDoubleLinkedBufIndex.OrderCurrentRecord;
+var ARecord: PBufRecLinkItem;
+    ABookmark: TBufBookmark;
+begin
+  // all records except current are already sorted
+  // check prior records
+  ARecord := FCurrentRecBuf;
+  repeat
+    ARecord := ARecord[IndNr].prior;
+  until not assigned(ARecord) or (IndexCompareRecords(ARecord, FCurrentRecBuf, DBCompareStruct) <= 0);
+  if assigned(ARecord) then
+    ARecord := ARecord[IndNr].next
+  else
+    ARecord := FFirstRecBuf;
+  if ARecord = FCurrentRecBuf then
+  begin
+    // prior record is less equal than current
+    // check next records
+    repeat
+      ARecord := ARecord[IndNr].next;
+    until (ARecord=FLastRecBuf) or (IndexCompareRecords(ARecord, FCurrentRecBuf, DBCompareStruct) >= 0);
+    if ARecord = FCurrentRecBuf[IndNr].next then
+      Exit; // current record is on proper position
+  end;
+  StoreCurrentRecIntoBookmark(@ABookmark);
+  RemoveRecordFromIndex(ABookmark);
+  FCurrentRecBuf := ARecord;
+  InsertRecordBeforeCurrentRecord(TRecordBuffer(ABookmark.BookmarkData));
+  GotoBookmark(@ABookmark);
+end;
+
 procedure TDoubleLinkedBufIndex.EndUpdate;
 begin
   FLastRecBuf[IndNr].next := FFirstRecBuf;
@@ -2242,18 +2275,14 @@ begin
       end;
 
     // Link the newly created record buffer to the newly created TDataset record
-    with ABookmark^ do
-      begin
-      FCurrentIndex.StoreCurrentRecIntoBookmark(@BookmarkData);
-      BookmarkFlag := bfInserted;
-      end;
+    FCurrentIndex.StoreCurrentRecIntoBookmark(ABookmark);
+    ABookmark^.BookmarkFlag := bfInserted;
 
     inc(FBRecordCount);
     end
   else
     InternalSetToRecord(ActiveBuffer);
 
-
   // If there is no updatebuffer already, add one
   if not GetActiveRecordUpdateBuffer then
     begin
@@ -2281,6 +2310,11 @@ begin
     end;
 
   move(ActiveBuffer^,FCurrentIndex.CurrentBuffer^,FRecordSize);
+
+  // new data are now in current record so reorder current record if needed
+  for i := 1 to FIndexesCount-1 do
+    if (i<>1) or (FIndexes[i]=FCurrentIndex) then
+      FIndexes[i].OrderCurrentRecord;
 end;
 
 procedure TCustomBufDataset.CalcRecordSize;
@@ -3683,6 +3717,11 @@ begin
   // Do nothing
 end;
 
+procedure TUniDirectionalBufIndex.OrderCurrentRecord;
+begin
+  // Do nothing
+end;
+
 procedure TUniDirectionalBufIndex.EndUpdate;
 begin
   // Do nothing
diff --git a/packages/fcl-db/tests/testdbbasics.pas b/packages/fcl-db/tests/testdbbasics.pas
index 549a88d839..bdb23d945b 100644
--- a/packages/fcl-db/tests/testdbbasics.pas
+++ b/packages/fcl-db/tests/testdbbasics.pas
@@ -2111,6 +2111,7 @@ procedure TTestBufDatasetDBBasics.TestIndexAppendRecord;
 var i: integer;
     LastValue: string;
 begin
+  // start with empty dataset
   with DBConnector.GetNDataset(true,0) as TCustomBufDataset do
   begin
     MaxIndexesCount:=4;
@@ -2125,19 +2126,20 @@ begin
     // append data at end
     for i:=20 downto 0 do
       AppendRecord([i, inttostr(i)]);
-    First;
     // insert data at begining
+    IndexName:='';
+    First;
     for i:=21 to 22 do
       InsertRecord([i, inttostr(i)]);
 
-    // ATM new records are not ordered as they are added ?
+    // swith to index and check if records are ordered
+    IndexName := 'testindex';
     LastValue := '';
     First;
     for i:=22 downto 0 do
     begin
       CheckEquals(23-i, RecNo, 'testindex.RecNo:');
-      CheckEquals(inttostr(i), Fields[1].AsString, 'testindex.Fields[1].Value:');
-      //CheckTrue(AnsiCompareStr(LastValue,Fields[1].AsString) < 0, 'testindex.LastValue>CurrValue');
+      CheckTrue(AnsiCompareStr(LastValue,Fields[1].AsString) < 0, 'testindex.LastValue>=CurrValue');
       LastValue := Fields[1].AsString;
       Next;
     end;