* Fix issue where refresh causes access violation in TBufDataset. Fixes issue #40987

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

@@ -694,6 +694,10 @@ type
   end;
 
   TBufDataset = class(TCustomBufDataset)
+  private
+    FCancelChangesOnRefresh: Boolean;
+  protected
+    procedure InternalRefresh; override;
   published
     property MaxIndexesCount;
     // TDataset stuff
@@ -725,6 +729,7 @@ type
     Property OnFilterRecord;
     Property OnNewRecord;
     Property OnPostError;
+    Property CancelChangesOnRefresh : Boolean Read FCancelChangesOnRefresh Write FCancelChangesOnRefresh default False;
   end;
 
 
@@ -1467,10 +1472,7 @@ begin
     InitDefaultIndexes;
     InitUserIndexes;
     If FIndexName<>'' then
-      FCurrentIndexDef:=TBufDatasetIndex(FIndexes.Find(FIndexName))
-    else if (FIndexFieldNames<>'') then
-      BuildCustomIndex;
-
+      FCurrentIndexDef:=TBufDatasetIndex(FIndexes.Find(FIndexName));
     CalcRecordSize;
 
     FBRecordCount := 0;
@@ -1480,6 +1482,9 @@ begin
         With BufIndexes[IndexNr] do
           InitialiseSpareRecord(IntAllocRecordBuffer);
 
+    if (FIndexName = '') and (FIndexFieldNames<>'') then
+      BuildCustomIndex;
+
     FAllPacketsFetched := False;
 
     FOpen:=True;
@@ -4075,6 +4080,17 @@ begin
   end;
 end;
 
+{ TBufDataset }
+
+procedure TBufDataset.InternalRefresh;
+begin
+  if (DataBase = nil) and (FFileName = '') then
+    DatabaseError(SErrNoInMemoryRefresh, Self);
+  if (ChangeCount>0) then
+    CancelUpdates;
+  inherited;
+end;
+
 { TArrayBufIndex }
 
 function TArrayBufIndex.GetBookmarkSize: integer;

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

@@ -101,7 +101,9 @@ Resourcestring
   SMaxIndexes              = 'The maximum amount of indexes is reached';
   SMinIndexes              = 'The minimum amount of indexes is 1';
   STooManyFields           = 'More fields specified then really exist';
-// These are added for Delphi-compatilility, but not used by the fcl:
+  SErrNoInMemoryRefresh    = 'In-memory table cannot be refreshed.';
+
+  // These are added for Delphi-compatilility, but not used by the fcl:
   SFieldIndexError         = 'Field index out of range';
   SIndexFieldMissing       = 'Cannot access index field ''%s''';
   SNoFieldIndexes          = 'No index currently active';

packages/fcl-db/tests/testspecifictbufdataset.pas

@@ -35,6 +35,7 @@ type
   private
     FAfterScrollCount:integer;
     FBeforeScrollCount:integer;
+    FDataset : TBufDataset;
     procedure DoAfterScrollCount(DataSet: TDataSet);
     procedure DoBeforeScrollCount(DataSet: TDataSet);
     procedure TestDataset(ABufDataset: TBufDataset; AutoInc: boolean = false);
@@ -58,6 +59,9 @@ type
     Procedure TestClear;
     procedure TestCopyFromDataset; //is copied dataset identical to original?
     procedure TestCopyFromDatasetMoved; //move record then copy. Is copy identical? Has record position changed?
+    procedure TestNoRefreshForInMemory; // Test that refresh with in-memory data raises an error.
+    procedure TestRefreshWithIndexOK; // Test that refresh works when indexes are defined
+    procedure TestCancelUpdatesOnRefresh; // Test that refresh works when changes are present and cancelupdatesonrefresh is true.
   end;
 
 implementation
@@ -427,6 +431,92 @@ begin
   AssertEquals('Mismatch between ID field contents - the record has moved.',CurrentID,NewID);
 end;
 
+procedure TTestSpecificTBufDataset.TestRefreshWithIndexOK;
+
+var
+  Dataset: TBufDataset;
+  FN : String;
+
+begin
+  Dataset := TBufDataset.Create(nil);
+  try
+    FN:=GetTempFileName;
+    if FileExists(GetTempFileName) then
+      AssertTrue('Delete existing db file',DeleteFile(FN));
+    Dataset.FileName := FN;
+    Dataset.FieldDefs.Add('LastName', ftString, 20);
+    Dataset.FieldDefs.Add('FirstName', ftString, 20);
+    Dataset.FieldDefs.Add('ID', ftString, 4);
+    Dataset.CreateDataset;
+
+    Dataset.Open;
+    Dataset.AppendRecord(['Jenkins', 'John', '0003']);
+    Dataset.AppendRecord(['Brooks', 'Jenny', '0001']);
+    Dataset.AppendRecord(['Adams', 'Paul', '0002']);
+    Dataset.Close;
+
+    Dataset.Open;
+    Dataset.IndexFieldNames := 'ID';
+    AssertNoException('Refresh OK',Dataset.Refresh);
+  finally
+    Dataset.Close;
+    Dataset.Free;
+  end;
+end;
+
+procedure TTestSpecificTBufDataset.TestCancelUpdatesOnRefresh;
+var
+  Dataset: TBufDataset;
+begin
+  Dataset := TBufDataset.Create(nil);
+  try
+    Dataset.FieldDefs.Clear;
+    Dataset.FieldDefs.Add('LastName', ftString, 20);
+    Dataset.FieldDefs.Add('FirstName', ftString, 20);
+    Dataset.FieldDefs.Add('ID', ftString, 4);
+    Dataset.CreateDataset;
+
+    Dataset.Open;
+    Dataset.IndexFieldNames := 'ID';
+    Dataset.AppendRecord(['Jenkins', 'John', '0003']);
+    Dataset.AppendRecord(['Brooks', 'Jenny', '0001']);
+    Dataset.AppendRecord(['Adams', 'Paul', '0002']);
+    AssertException('Refresh raises error',EDatabaseError,Dataset.Refresh);
+    Dataset.CancelChangesOnRefresh:=True;
+    AssertNoException('Refresh raises no error if CancelChangesOnRefresh is set',Dataset.Refresh);
+    AssertEquals('Changes have been deleted',0,Dataset.ChangeCount);
+  finally
+    Dataset.Close;
+    Dataset.Free;
+  end;
+end;
+
+procedure TTestSpecificTBufDataset.TestNoRefreshForInMemory;
+var
+  Dataset: TBufDataset;
+begin
+  Dataset := TBufDataset.Create(nil);
+  try
+    Dataset.FieldDefs.Clear;
+    Dataset.FieldDefs.Add('LastName', ftString, 20);
+    Dataset.FieldDefs.Add('FirstName', ftString, 20);
+    Dataset.FieldDefs.Add('ID', ftString, 4);
+    Dataset.CreateDataset;
+
+    Dataset.Open;
+    Dataset.AppendRecord(['Jenkins', 'John', '0003']);
+    Dataset.AppendRecord(['Brooks', 'Jenny', '0001']);
+    Dataset.AppendRecord(['Adams', 'Paul', '0002']);
+
+    Dataset.Open;
+    Dataset.IndexFieldNames := 'ID';
+    AssertException('Refresh raises error',EDatabaseError,Dataset.Refresh);
+  finally
+    Dataset.Close;
+    Dataset.Free;
+  end;
+end;
+
 initialization
 {$ifdef fpc}