paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-16 23:49:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazDebuggerFp: catch exceptions in Application.ProcessMessages

Browse Source
This commit is contained in:
Martin 2021-12-11 13:43:48 +01:00
parent a4b23e0b2a
commit 4c78791096
1 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas
View File

@ -408,6 +408,7 @@ type
procedure StopAllWorkers;
function IsPausedAndValid: boolean; // ready for eval watches/stack....
procedure DoProcessMessages;
property DebugInfo: TDbgInfo read GetDebugInfo;
public
constructor Create(const AExternalDebugger: String); override;
@ -668,7 +669,7 @@ var
c: LongInt;
begin
FpDebugger.FWorkQueue.Lock;
Application.ProcessMessages;
FpDebugger.DoProcessMessages;
FpDebugger.CheckAndRunIdle;
(* IdleThreadCount could (race condition) be to high.
Then DebugHistory may loose ONE item. (only one working thread.
@ -679,7 +680,7 @@ begin
FpDebugger.FWorkQueue.Unlock;
if c = 0 then begin
Application.ProcessMessages;
FPDebugger.DoProcessMessages;
FpDebugger.StartDebugLoop;
end
else begin
@ -3197,7 +3198,7 @@ procedure TFpDebugDebugger.FreeDebugThread;
begin
FWorkQueue.TerminateAllThreads(True);
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
Application.ProcessMessages; // run the AsyncMethods
DoProcessMessages // run the AsyncMethods
end;
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(
@ -3623,7 +3624,7 @@ begin
c := FWorkQueue.Count + FWorkQueue.ThreadCount - FWorkQueue.IdleThreadCount;
FWorkQueue.Unlock;
if c = 0 then
Application.ProcessMessages;
DoProcessMessages;
end
else
c := 0;
@ -3926,9 +3927,18 @@ begin
(FDbgController.CurrentProcess <> nil);
end;
procedure TFpDebugDebugger.DoProcessMessages;
begin
try
Application.ProcessMessages;
except
on E: Exception do debugln(['Application.ProcessMessages crashed with ', E.Message]);
end;
end;
constructor TFpDebugDebugger.Create(const AExternalDebugger: String);
begin
ProcessMessagesProc := @Application.ProcessMessages;
ProcessMessagesProc := @DoProcessMessages;
inherited Create(AExternalDebugger);
FLockList := TFpDbgLockList.Create;
FWorkQueue := TFpThreadPriorityWorkerQueue.Create(100);
@ -3971,7 +3981,7 @@ begin
except
end;
FWorkQueue.TerminateAllThreads(True);
Application.ProcessMessages; // run the AsyncMethods
DoProcessMessages; // run the AsyncMethods
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
Application.RemoveAsyncCalls(Self);