paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-19 01:29:31 +02:00
Code Issues Packages Projects Releases Wiki Activity

DBG: Prevent potential crash in (dbg-)OnIdle handling

Browse Source 
git-svn-id: trunk@37920 -
This commit is contained in:
martin 2012-07-12 15:06:14 +00:00
parent 27ad4cf344
commit c333eda9b8
1 changed files with 22 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
debugger/gdbmidebugger.pp
View File

@ -370,6 +370,7 @@ type
FExceptionBreak: TGDBMIInternalBreakPoint;
FPauseWaitState: TGDBMIPauseWaitState;
FInExecuteCount: Integer;
FInIdle: Boolean;
FRunQueueOnUnlock: Boolean;
FDebuggerFlags: TGDBMIDebuggerFlags;
FSourceNames: TStringList; // Objects[] -> TMap[Integer|Integer] -> TDbgPtr
@ -6659,8 +6660,24 @@ begin
FCurrentCommand := NestedCurrentCmd;
end;
if (FCommandQueue.Count = 0) and assigned(OnIdle)
then OnIdle(Self);
if (FCommandQueue.Count = 0) and assigned(OnIdle) and (FInExecuteCount=0) and (not FInIdle)
then begin
repeat
DebugLnEnter(DBGMI_QUEUE_DEBUG, ['>> Run OnIdle']);
LockCommandProcessing;
FInIdle := True;
try
OnIdle(Self);
finally
R := (FCommandQueue.Count > 0) and (FCommandProcessingLock = 1) and FRunQueueOnUnlock;
DebugLn(DBGMI_QUEUE_DEBUG, ['OnIdle: UnLock']);
UnLockCommandProcessing;
FInIdle := False;
end;
DebugLnExit(DBGMI_QUEUE_DEBUG, ['<< Run OnIdle']);
until not R;
DebugLn(DBGMI_QUEUE_DEBUG, ['OnIdle: Finished ']);
end;
if FNeedStateToIdle and (FInExecuteCount = 0)
then ResetStateToIdle;
@ -7283,6 +7300,7 @@ begin
FPauseWaitState := pwsNone;
FErrorHandlingFlags := [];
FInExecuteCount := 0;
FInIdle := False;
FNeedStateToIdle := False;
Options := '-silent -i mi -nx';
@ -8563,7 +8581,7 @@ begin
and (Debugger.State = dsPause)
then RegistersNeeded;
Result := Length(FRegNames)
Result := Length(FRegNames);
end;
function TGDBMIRegisters.GetModified(const AnIndex: Integer): Boolean;
@ -8675,7 +8693,7 @@ end;
function TGDBMIRegisters.GetDebugger: TGDBMIDebugger;
begin
Result := TGDBMIDebugger(inherited Debugger)
Result := TGDBMIDebugger(inherited Debugger);
end;
procedure TGDBMIRegisters.DoGetRegValuesDestroyed(Sender: TObject);