Sequentially executing queries in parallel running threads

[alexicum]

We are opening TSqlConnection to different DB inside every thread.
Query inserts records into DB table. There is DateInserted field in DB. Experiment shows us that records are inserted in sequent order in different DB's.

Queries in parallel threads are running in sequent order.

Another (not Devart) driver executing all queries simultaneously.

[alexicum]

The problem is actual when using devart driver with Firebird 2.1 fbclient.dll.
There is no such trouble with FB 2.5 client library.

[alexicum]

Code: Select all

program ThreadsProject;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  DB,
  SqlExpr;

type
  TDBInfoRec = record
    DriverName: string;
    ConnectionName: string;
    DBName:  string;
  end;


  TWorkThread = class(TThread)
  private
    FSQLConnection: TSQLConnection;
    FSQLQuery: TSQLQuery;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy; override;

    property SQLConnection: TSQLConnection read FSQLConnection write FSQLConnection;
    property SQLQuery: TSQLQuery read FSQLQuery write FSQLQuery;
  end;


{ TWorkThread }

constructor TWorkThread.Create(CreateSuspended: Boolean);
begin
  inherited;
  FSQLConnection := TSQLConnection.Create(nil);
  FSQLQuery := TSQLQuery.Create(nil);
  FSQLQuery.SQLConnection := FSQLConnection;
end;

destructor TWorkThread.Destroy;
begin
  if Assigned(FSQLQuery) then FreeAndNil(FSQLQuery);
  if Assigned(FSQLConnection) then FreeAndNil(FSQLConnection);
  inherited;
end;

procedure TWorkThread.Execute;
begin
  inherited;
  FSQLConnection.Open;
  FSQLQuery.ExecSQL(True);
end;

function CheckAllThreadsFinished(aThreadsList: TList): Boolean;
var
  i: Integer;
  nFinished: integer;
begin
  nFinished := 0;
  for i := 0 to aThreadsList.Count - 1 do
    if TWorkThread(aThreadsList[i]).Finished then
      Inc(nFinished);
  Result := aThreadsList.Count = nFinished;
end;

var
//  nThreads: Integer;
  i: Integer;
  aDBInfo: array [0..1] of TDBInfoRec;
  aWorkThreads: TList;
  oThread: TWorkThread;
begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
    aDBInfo[0].DriverName := 'DevartInterBase';
    aDBInfo[0].ConnectionName := 'Devart driver';
    aDBInfo[0].DBName := 'localhost:e:\Work\Projects\TEST.FDB';

    aDBInfo[1].DriverName := 'DevartInterBase';
    aDBInfo[1].ConnectionName := 'Devart driver COPY';
    aDBInfo[1].DBName := 'localhost:e:\Work\Projects\TEST_COPY.FDB';

    aWorkThreads := TList.Create;
    try
      for i := Low(aDBInfo) to High(aDBInfo) do begin
        oThread := TWorkThread.Create(True);
        oThread.SQLConnection.DriverName := aDBInfo[i].DriverName;
        oThread.SQLConnection.ConnectionName := aDBInfo[i].ConnectionName;
        oThread.SQLConnection.Params.Values['Database'] := aDBInfo[i].DBName;
        oThread.SQLConnection.Params.Values['User_Name'] := 'admin';
        oThread.SQLConnection.Params.Values['Password'] := 'admin';
        oThread.SQLQuery.CommandText := 'execute procedure TMP_TEST_SP;';
        aWorkThreads.Add(oThread);
      end;

      // Стартуем потоки
      for i := Low(aDBInfo) to High(aDBInfo) do begin
        TWorkThread(aWorkThreads[i]).Resume;
      end;

      // Ожидаем завершения работы потоков
      while not CheckAllThreadsFinished(aWorkThreads) do
        Sleep(50);
    finally
      while aWorkThreads.Count > 0 do begin
        TWorkThread(aWorkThreads[0]).Free;
        aWorkThreads.Delete(0);
      end;
      aWorkThreads.Free;
    end;
  except
    on E:Exception do
      Writeln(E.Classname, ': ', E.Message);
  end;
end.

Объекты БД, для теста:

Code: Select all

SET TERM ^ ;
CREATE TABLE TMP_TEST (
    DB_NAME        VARCHAR(10) DEFAULT 'TEST',
    DATE_INSERTED  VARCHAR(30),
    VAL            INTEGER
)^
/* Trigger: TMP_TEST_BI */
CREATE OR ALTER TRIGGER TMP_TEST_BI FOR TMP_TEST
ACTIVE BEFORE INSERT POSITION 0
as
begin
  select cast('NOW' as timestamp) from rdb$database
    into NEW.date_inserted;
end
^
create or alter procedure TMP_TEST_SP
returns (
    VAL integer,
    DB_NAME varchar(10),
    DATE_INSERTED varchar(30))
AS
declare variable I integer;
declare variable P integer;
BEGIN
  delete from tmp_test;
  P = 0;
  WHILE (P < 1000) DO BEGIN
    insert into TMP_TEST(VAL) values(:P);
    P = P + 1;
    I = 0;
    while (i < 10000) do I = I + 1;
  END
  FOR SELECT VAL, DB_NAME, DATE_INSERTED
  FROM TMP_TEST
  into :VAL, :DB_NAME, DATE_INSERTED do
  BEGIN
    SUSPEND;
  END
END^
SET TERM ; ^

[ZEuS]

This behaviour is not due to an error in dbExpress driver for InterBase & Firebird, but due to the specificity of working with different Firebird versions in multi-threaded applications.
Firebird versions lower than 2.5 have not thread-safe client libraries. Using these libraries in a multi-threaded application can cause numerous errors. To avoid these errors, we implemented thread-safety for the client library on our own.
There is a special global variable - ThreadSafetyClientLibrary - declared in the IBCCall unit, which is used to control the thread-safety state. Its default value is True, and the tread-safety is enabled by default. Try to set ThreadSafetyClientLibrary to False and check the application execution results.

[alexicum]

We have no sources, only bpl. How can we switch it?

[ZEuS]

In this case, if you are using Firebird server version 2.1, you can try to use the Firebird 2.5 client library (fbclient.dll) with your application. The Firebird 2.5 client library is thread-safe, therefore our implementation of the thread-safety will be disabled.