paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 04:39:22 +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; procedure StopAllWorkers;
function IsPausedAndValid: boolean; // ready for eval watches/stack.... function IsPausedAndValid: boolean; // ready for eval watches/stack....
procedure DoProcessMessages;
property DebugInfo: TDbgInfo read GetDebugInfo; property DebugInfo: TDbgInfo read GetDebugInfo;
public public
constructor Create(const AExternalDebugger: String); override; constructor Create(const AExternalDebugger: String); override;
@ -668,7 +669,7 @@ var
c: LongInt; c: LongInt;
begin begin
FpDebugger.FWorkQueue.Lock; FpDebugger.FWorkQueue.Lock;
Application.ProcessMessages; FpDebugger.DoProcessMessages;
FpDebugger.CheckAndRunIdle; FpDebugger.CheckAndRunIdle;
(* IdleThreadCount could (race condition) be to high. (* IdleThreadCount could (race condition) be to high.
Then DebugHistory may loose ONE item. (only one working thread. Then DebugHistory may loose ONE item. (only one working thread.
@ -679,7 +680,7 @@ begin
FpDebugger.FWorkQueue.Unlock; FpDebugger.FWorkQueue.Unlock;
if c = 0 then begin if c = 0 then begin
Application.ProcessMessages; FPDebugger.DoProcessMessages;
FpDebugger.StartDebugLoop; FpDebugger.StartDebugLoop;
end end
else begin else begin
@ -3197,7 +3198,7 @@ procedure TFpDebugDebugger.FreeDebugThread;
begin begin
FWorkQueue.TerminateAllThreads(True); FWorkQueue.TerminateAllThreads(True);
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF} {$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
Application.ProcessMessages; // run the AsyncMethods DoProcessMessages // run the AsyncMethods
end; end;
procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent( procedure TFpDebugDebugger.FDbgControllerHitBreakpointEvent(
@ -3623,7 +3624,7 @@ begin
c := FWorkQueue.Count + FWorkQueue.ThreadCount - FWorkQueue.IdleThreadCount; c := FWorkQueue.Count + FWorkQueue.ThreadCount - FWorkQueue.IdleThreadCount;
FWorkQueue.Unlock; FWorkQueue.Unlock;
if c = 0 then if c = 0 then
Application.ProcessMessages; DoProcessMessages;
end end
else else
c := 0; c := 0;
@ -3926,9 +3927,18 @@ begin
(FDbgController.CurrentProcess <> nil); (FDbgController.CurrentProcess <> nil);
end; 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); constructor TFpDebugDebugger.Create(const AExternalDebugger: String);
begin begin
ProcessMessagesProc := @Application.ProcessMessages; ProcessMessagesProc := @DoProcessMessages;
inherited Create(AExternalDebugger); inherited Create(AExternalDebugger);
FLockList := TFpDbgLockList.Create; FLockList := TFpDbgLockList.Create;
FWorkQueue := TFpThreadPriorityWorkerQueue.Create(100); FWorkQueue := TFpThreadPriorityWorkerQueue.Create(100);
@ -3971,7 +3981,7 @@ begin
except except
end; end;
FWorkQueue.TerminateAllThreads(True); FWorkQueue.TerminateAllThreads(True);
Application.ProcessMessages; // run the AsyncMethods DoProcessMessages; // run the AsyncMethods
{$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF} {$IFDEF FPDEBUG_THREAD_CHECK} CurrentFpDebugThreadIdForAssert := MainThreadID;{$ENDIF}
Application.RemoveAsyncCalls(Self); Application.RemoveAsyncCalls(Self);