[Patch] Crashes of TCustomBufDataset descendants when Refresh is called

Summary

TBufDataset and its descendants (TBufDataset, TSQLQuery) crash when the Refresh method is called, in particular when a fieldname is assigned to the IndexFieldNames property. There are several scenarios in which issues occur:

• crash in SQLQuery
• crash in TBufDataset
• data-loss in in-memory TBufDataset

System Information

• Operating system: Windows 11
• Processor architecture: x86-64
• Compiler version: 3.2.2, trunk (maybe more)
• Device: Computer

Steps to reproduce, sample projects and analysis

The following tests and analysis was done together with user "Sieben" of the German Lazarus forum who brought up this issue initially (https://www.lazarusforum.de/viewtopic.php?f=17&t=16223).

Case 1: TSQLQuery

The following FCL-only code creates an SQLite3 database, adds some records, sets a field to the IndexFieldNames of the SQLQuery and then calls the query's Refresh method. The program crashes with the error message "External: ACCESS VIOLATION' reading from address $0000000000000000."

program TSQLQuery_Refresh;
uses
  SysUtils, db, SQLDB, SQLite3Conn;
const
  DB_FILE_NAME = 'testdata.db';
var
  Connection: TSQLite3Connection;
  Transaction: TSQLTransaction;
  Dataset: TSQLQuery;
begin
  Transaction := TSQLTransaction.Create(nil);
  Connection := TSQLite3Connection.Create(nil);
  Connection.Transaction := Transaction;
  Connection.DatabaseName := DB_FILE_NAME;
  Dataset := TSQLQuery.Create(nil);
  try
    if not FileExists(DB_FILE_NAME) then
    begin
      Connection.Open;
      Transaction.StartTransaction;
      Connection.ExecuteDirect(
        'CREATE TABLE Data (ID VARCHAR(4) PRIMARY KEY, LastName VARCHAR(20), FirstName VARCHAR(20));'
      );
      Transaction.Commit;

      Connection.Open;
      Transaction.StartTransaction;
      Connection.ExecuteDirect(
        'INSERT INTO Data (ID, LastName, FirstName) VALUES (''0003'', ''Jenkins'', ''John'');');
      Connection.ExecuteDirect(
        'INSERT INTO Data (ID, LastName, FirstName) VALUES (''0001'', ''Brooks'', ''Jenny'');');
      Connection.ExecuteDirect(
        'INSERT INTO Data (ID, LastName, FirstName) VALUES (''0002'', ''Adams'', ''Paul'');');
      Transaction.Commit;
    end;
    Connection.Open;

    Dataset.Database := Connection;
    Dataset.SQL.Text := 'SELECT * FROM Data';
    Dataset.Open;

    Dataset.IndexFieldNames := 'ID';
    Dataset.Refresh;
  finally
    Dataset.Close;
    Dataset.Free;
    Transaction.Free;
    Connection.Free;
  end;
end.

The debugger shows that when Refresh is executed the dataset is closed and later re-opened. When the dataset is closed the array FFieldBufPositions is emptied. It is recreated in the procedure CalcRecordSize of InternalOpen. However, the array is accessed already before creation in BuildCustomIndex > BuildIndex > ProcessFieldsToCompareStruct' which are executed here because IndexFieldNames' is not empty.

As a solution we propose to move this section of the code down by a few lines:

procedure TCustomBufDataset.InternalOpen;
[...]
    InitDefaultIndexes;
    InitUserIndexes;
    If FIndexName<>'' then
      FCurrentIndexDef:=TBufDatasetIndex(FIndexes.Find(FIndexName));
    // <<<< move this from here ...
    // else if (FIndexFieldNames<>'') then
    //   BuildCustomIndex;

    CalcRecordSize;

    FBRecordCount := 0;

    for IndexNr:=0 to FIndexes.Count-1 do
      if Assigned(BufIndexdefs[IndexNr]) then
        With BufIndexes[IndexNr] do
          InitialiseSpareRecord(IntAllocRecordBuffer);

    FAllPacketsFetched := False;

    // <<< ... to here
    if (FIndexName='') and (FIndexFieldNames<>'') then
      BuildCustomIndex;

    FOpen:=True;

    // parse filter expression
    ParseFilter(Filter);
[...]

This fixes the crash.

Case 2: TBufDataset

The same problem should occur also in TBufDataset which is another descendant of TCustomBufDataset. The test code was modified as follows:

program TBufDataset_Refresh;
uses
  SysUtils, db, BufDataset;
const
  DB_FILE_NAME = 'testdata.db';
var
  Dataset: TBufDataset;
begin
  Dataset := TBufDataset.Create(nil);
  try
    Dataset.FileName := DB_FILE_NAME;
    if not FileExists(DB_FILE_NAME) then
    begin
      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']);
    end;

    Dataset.Open;
    Dataset.IndexFieldNames := 'ID';
    Dataset.Refresh;
  finally
    Dataset.Close;
    Dataset.Free;
  end;
end.

However, the program crashes with a different error message "Must apply updates before refreshing data". This is at the beginning of TCustomBufDataset.InternalRefresh:

procedure TCustomBufDataset.InternalRefresh;
[...]
begin
  if length(FUpdateBuffer)>0 then
    DatabaseError(SErrApplyUpdBeforeRefresh,Self);  // <--- CRASH HERE
  [...]

Based on what the overridden method of TSQLQuery does here, we propose the following change for TBufDataset:

procedure TBufDataset.InternalRefresh;  // override
begin
  if (ChangeCount>0) and (sqoCancelUpdatesOnRefresh in Options) then
    CancelUpdates;
  inherited InternalRefresh;
end;

This avoids the DatabaseError and, in the otherwise unpatched BufDataset unit, brings up the exception discussed above for TSQLQuery. Applying also mentioned changed in TCustomBufDataset.InternalOpen fixes these crashes altogether.

Case 3: In-memory TBufDataset and Refresh

We're not done, yet...

During investigation, we found an issue related to the Refresh method in case of an in-memory TBufDataset. This is because Refresh erases the data during InternalClose, but cannot reload them during InternalOpen- simply because they were stored only in memory. In order to warn the user of this data loss we propose to extend TBufDataset.InternalRefresh such that it fires a DatabaseErrorexception when the FileName of the BufDataset is empty, i.e. when we have an in-memory table.

resourcestring
  SErrNoInMemoryRefresh = 'In-memory table cannot be refreshed.';
procedure TBufDataset.InternalRefresh;
begin
  if (DataBase = nil) or (FFileName = '') then
    DatabaseError(SErrNoInMemoryRefresh, Self);
  if (ChangeCount>0) then
    CancelUpdates;
  inherited;
end;

Patch

Here is a patch in which the proposed changes are summarized: 40987-tcustombufdataset-refresh.diff

And in the following zip we attach the two test projects mentioned: 40987_-_TCustomDataset_Refresh_Crash.zip