TGtk2WidgetSet.AppProcessMessages and Application.Idle(True) fail to call CheckSynchronize a second time
Original Reporter info from Mantis: kluug.net @onpok
-
Reporter name: Ondrej Pokorny
Original Reporter info from Mantis: kluug.net @onpok
- Reporter name: Ondrej Pokorny
Description:
If you are in Application.ProcessMessages/Application.Idle(True) loop that was called from Synchronize, CheckSynchronize is not called and so the execution stays in the loop infinitely.
I tested Win32, OSX (Darwin) and Gtk2. Win32 and Darwin work properly, Gtk2 fails to call CheckSynchronize.
Steps to reproduce:
Call TestThread in a LCL application.
type
TMyThread = class(TThread)
private
fCounter: Integer;
fFinished: Boolean;
procedure StartNew;
protected
procedure Execute; override;
public
constructor Create(aCounter: Integer);
property Terminated;
end;
{ TMyThread }
constructor TMyThread.Create(aCounter: Integer);
begin
inherited Create(False);
fCounter := aCounter;
end;
procedure TMyThread.Execute;
begin
Sleep(50);
Synchronize(StartNew);
fFinished := True;
end;
procedure TMyThread.StartNew;
var
xThread: TMyThread;
begin
if fCounter < 2 then
begin
xThread := TMyThread.Create(fCounter+1);
xThread.FreeOnTerminate := False;
while not xThread.fFinished do
begin
//dead-lock here in 2nd thread -> CheckSynchronize is not called
Application.ProcessMessages;
Application.Idle(True);
end;
xThread.Free;
end;
end;
procedure TestThread;
var
xThread: TThread;
begin
xThread := TMyThread.Create(0);
xThread.FreeOnTerminate := True;
end;
Additional information:
A quick solution would be to call CheckSynchronize directly in AppProcessMessages (as it is done e.g. in Win32):
procedure TGtk2WidgetSet.AppProcessMessages;
function PendingGtkMessagesExists: boolean;
begin
{$IFDEF USE_GTK_MAIN_OLD_ITERATION}
Result:=(gtk_events_pending<>0) or LCLtoGtkMessagePending;
{$ELSE}
Result := g_main_context_pending(g_main_context_default) or
LCLtoGtkMessagePending;
{$ENDIF}
end;
var
vlItem : TGtkMessageQueueItem;
vlMsg : PMSg;
i: Integer;
begin
vlMsg:=nil;//ONDREJ
repeat
// send cached LCL messages to the gtk
//DebugLn(['TGtk2WidgetSet.AppProcessMessages SendCachedLCLMessages']);
SendCachedLCLMessages;
// let gtk handle up to 100 messages and call our callbacks
i:=100;
if not FGtkTerminated then
begin
{$IFDEF USE_GTK_MAIN_OLD_ITERATION}
while (gtk_events_pending<>0) and (i>0) do
begin
if FGtkTerminated then
break;
gtk_main_iteration_do(False);
dec(i);
end;
{$ELSE}
while g_main_context_pending(g_main_context_default) and (i>0) do
begin
if FGtkTerminated then
break;
if not g_main_context_iteration(g_main_context_default, False) then
break;
dec(i);
end;
{$ENDIF}
end;
//DebugLn(['TGtk2WidgetSet.AppProcessMessages SendCachedGtkMessages']);
// send cached gtk messages to the lcl
SendCachedGtkMessages;
// then handle our own messages
while not Application.Terminated do begin
fMessageQueue.Lock;
try
// fetch first message
vlItem := fMessageQueue.FirstMessageItem;
if vlItem = nil then break;
// remove message from queue
if vlItem.IsPaintMessage then begin
//DebugLn(['TGtk2WidgetSet.AppProcessMessages Paint: ',DbgSName(GetLCLObject(Pointer(vlItem.Msg^.hwnd)))]);
// paint messages are the most expensive messages in the LCL,
// therefore they are sent after all other
if MovedPaintMessageCount<10 then begin
inc(MovedPaintMessageCount);
if fMessageQueue.HasNonPaintMessages then begin
// there are non paint messages -> move paint message to the end
fMessageQueue.MoveToLast(FMessageQueue.First);
continue;
end else begin
// there are only paint messages left in the queue
// -> check other queues
if PendingGtkMessagesExists then break;
end;
end else begin
// handle this paint message now
MovedPaintMessageCount:=0;
end;
end;
//DebugLn(['TGtk2WidgetSet.AppProcessMessages SendMessage: ',DbgSName(GetLCLObject(Pointer(vlItem.Msg^.hwnd)))]);
vlMsg:=fMessageQueue.PopFirstMessage;
finally
fMessageQueue.UnLock;
end;
//debugln(['TGtk2WidgetSet.AppProcessMessages ',vlMsg^.Message,' ',LM_CHAR,' ',dbgsname(GetLCLObject(Pointer(vlMsg^.hwnd)))]);
// Send message
if vlMsg <> nil then
begin
try
with vlMsg^ do SendMessage(hWND, Message, WParam, LParam);
finally
Dispose(vlMsg);
end;
end;
end;
// proceed until all messages are handled
until (not PendingGtkMessagesExists) or Application.Terminated;
//ONDREJ
if (vlMsg=nil) and IsMultiThread then//no message was handled -> CheckSynchronize
CheckSynchronize;
end;
Mantis conversion info:
- Mantis ID: 27662
- Platform: Linux / Gtk2
- Version: 1.5 (SVN)
- Fixed in revision: 62989 (#5d0de1d6)