TFDEventAlerter bug?

[Rafael Dipold 0]

I've created an MCVE that simulates a problem that eventually happens in our software, where software freezes when it tries to register an event when a previously registered event triggers within the same cycle.

 

In an internal test, we found that this also occurs using the TIB_Events component.

 

Would this be a Firebird or FireDAC bug?

 

unit Unit1;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  System.Classes,
  System.SysUtils,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.StdCtrls,
  FireDAC.Comp.Client,
  FireDAC.Comp.UI,
  FireDAC.Phys,
  FireDAC.Phys.FB,
  FireDAC.Phys.FBDef,
  FireDAC.Phys.IBBase,
  FireDAC.Stan.Async,
  FireDAC.Stan.Def,
  FireDAC.Stan.Intf,
  FireDAC.UI.Intf,
  FireDAC.VCLUI.Wait;

type
  TForm1 = class(TForm)
    Button1: TButton;

    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FConn : TFDConnection;
    FEvents: TFDEventAlerter;
    procedure EventAlert(ASender: TFDCustomEventAlerter; const AEventName: String; const AArgument: Variant);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  FConn.ExecSQL('EXECUTE BLOCK AS BEGIN POST_EVENT ''EVENT_1''; END');

  FEvents.Names.Add('EVENT_2');
end;

procedure TForm1.EventAlert(ASender: TFDCustomEventAlerter; const AEventName: String; const AArgument: Variant);
begin
  Caption := AEventName + ' ' + DateTimeToStr(Now);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FConn := TFDConnection.Create(nil);
  FConn.LoginPrompt := False;
  FConn.DriverName                    := 'FB';
  FConn.Params.Values['DriverID']     := 'FB';
  FConn.Params.Values['CharacterSet'] := 'ISO8859_1';
  FConn.Params.Values['Server']    := '127.0.0.1';
  FConn.Params.Values['Database']  := 'c:\temp\whatever.fdb';
  FConn.Params.Values['User_Name'] := 'SYSDBA';
  FConn.Params.Values['Password']  := 'masterkey';

  FEvents := TFDEventAlerter.Create(nil);
  FEvents.Connection := FConn;
  FEvents.Names.Add('EVENT_1');
  FEvents.OnAlert := EventAlert;
  FEvents.Register;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FEvents.Free;
  FConn.Free;
end;

end.

 

[WillH 33]

I found a similar bug where the Firebird client will lock up if you try to create two connections at the same time in different threads. In my case I could only reproduce it when a local connection was used. I had to change the API call in IBX so that it was wrapped in a critical section.

 

IBIntf.pas

//Create and destroy the critical section in the initialization and finalization sections.
ConnLock : TCriticalSection ;

function TDynamicLibrary.isc_attach_database(status_vector: PISC_STATUS;
  db_name_length: Short; db_name: PAnsiChar; db_handle: PISC_DB_HANDLE;
  parm_buffer_length: Short; parm_buffer: PByte): ISC_STATUS;
begin
  ConnLock.Acquire ;
  try
    Result := Fisc_attach_database(status_vector, db_name_length, db_name,
                db_handle, parm_buffer_length, parm_buffer);
  finally
    ConnLock.Release ;
  end;
end;

 

So, have a look at the API call that is being made to make sure it is thread safe. Wrap your calls in a critical section.

 

On a similar note. The events may be getting raised in the context of a background thread, So updating the form caption from that event may be the cause of your lock up. Try using PostMessage to pass the event to the main form in a thread safe way. Or use OutputDebugString for the purposes of your test.

 

 

[WillH 33]

See

http://docwiki.embarcadero.com/RADStudio/Rio/en/Database_Alerts_(FireDAC)

 

Quote

The OnAlert event handler can be called in the main or background thread contexts. Use the Options.Synchronize property to control that.

 

Try setting

 

FEvents.Options.Synchronize := True;

[Rafael Dipold 0]

FEvents.Options.Synchronize := True;

I had already tried this option without success.

I also tried to force the registration of the event on a Thread Synchronize, but if more than on event register or trigger in the same cycle, the software also freezes:

 

TThread.CreateAnonymousThread(
procedure
begin
  TThread.Synchronize(nil,
  procedure
  begin
    FBEvents.Events.Add('EVENT_2');
  end);
end).Start;

 

@WillH PostMessage() happens the same as Thread.Synchronize() if more than one event trigger. Both only minimize the problem:

 

procedure TForm1.Button1Click(Sender: TObject);
begin
  FConn.ExecSQL('EXECUTE BLOCK AS BEGIN POST_EVENT ''EVENT_1''; END');
  FConn.ExecSQL('EXECUTE BLOCK AS BEGIN POST_EVENT ''EVENT_1''; END');

  PostMessage(Handle, WM_EVENT_MESSAGE, Integer(PChar('EVENT_2')), 0);
end;

 

[WillH 33]

This looks like a threading issue in FireDAC. When you add a new event listener the event listener unregisters all the events it has and then registers everything again. I've traced it back to uADPhysManager (Yes I have the older source code, but I imagine things are pretty similar in your source)

 

I think that stopping the listener thread is failing because there is an inbound event.

 

procedure TADPhysEventAlerter.AbortJob;
begin
  try
    InternalAbortJob;
    FMsgThread.Active := False;    // Locks here
  except
    // not visible
  end;
end;

Just changing your code to use unregister will also trigger the problem.

 

procedure TForm1.Button1Click(Sender: TObject);
begin
  FConn.ExecSQL('EXECUTE BLOCK AS BEGIN POST_EVENT ''EVENT_1''; END');

  FEvents.Unregister;
end;

 

Maybe, if you don't have many events you could try one event alerter instance per event.

 

I don't get the same error with IBX TIBEvents so maybe you could use that for the event alerts instead.

 

 

[Rafael Dipold 0]

@WillH Thanks for help.

 

For now, I'm registering all my 53 events at software startup, but ideally I'd like to register only when it's needed.

 

I'm going to post this problem on Embarcadero's Quality Portal, but without much hope that the Embarcadero will comment on it.

 

Update: https://quality.embarcadero.com/browse/RSP-24789

Edited July 3, 2019 by Rafael Dipold
Update with the link to Issue

[Dmitry Arefiev 101]

There are two options:

1) Modify your code. In EventAlert use:

  TThread.Queue(nil,
    procedure
    begin
      Caption := AEventName + ' ' + DateTimeToStr(Now);
    end);

And in FormCreate set:

  FEvents.Options.Synchronize := False;

2) Modify FireDAC sources. For that in FireDAC.Phys.pas change method:

function TFDPhysEventMessage.Perform(AThread: TFDThread): Boolean;
begin
  FMsgThread := AThread as TFDPhysEventThread;
  if FMsgThread.Active then begin
    if FMsgThread.FAlerter.GetOptions.Synchronize then
      TFDThread.Queue(nil, BasePerform)
    else
      BasePerform;
  end;
  Result := True;
end;

 

[Rafael Dipold 0]

Thanks, the solution 1 works fine for me.