paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 13:08:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpdebug: prevent crash due to early self.destroy, when stopping the debugger

Browse Source 
git-svn-id: trunk@48999 -
This commit is contained in:
martin 2015-05-12 20:00:45 +00:00
parent fe33405ec7
commit 88dd20916e
1 changed files with 59 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -91,6 +91,8 @@ type
FMemReader: TDbgMemReader;
FMemManager: TFpDbgMemManager;
FConsoleOutputThread: TThread;
FReleaseLock: Integer;
FReleaseNeeded: Boolean;
{$ifdef linux}
FCacheLine: cardinal;
FCacheFileName: string;
@ -113,6 +115,8 @@ type
procedure DoWatchFreed(Sender: TObject);
procedure ProcessASyncWatches({%H-}Data: PtrInt);
procedure DoLog({%H-}Data: PtrInt);
procedure IncReleaseLock;
procedure DecReleaseLock;
protected
procedure ScheduleWatchValueEval(AWatchValue: TWatchValue);
function EvaluateExpression(AWatchValue: TWatchValue;
@ -140,6 +144,7 @@ type
procedure StartDebugLoop;
procedure DebugLoopFinished;
procedure QuickPause;
procedure DoRelease; override;
procedure DoState(const OldState: TDBGState); override;
{$ifdef linux}
procedure DoAddBreakLine;
@ -1047,8 +1052,13 @@ begin
{$PUSH}{$R-}
DoDbgEvent(ecProcess, etProcessExit, Format('Process exited with exit-code %d',[AExitCode]));
{$POP}
SetState(dsStop);
FreeDebugThread;
IncReleaseLock;
try
SetState(dsStop);
FreeDebugThread;
finally
DecReleaseLock;
end;
end;
procedure TFpDebugDebugger.FDbgControllerExceptionEvent(var continue: boolean;
@ -1300,6 +1310,18 @@ begin
end;
end;
procedure TFpDebugDebugger.IncReleaseLock;
begin
inc(FReleaseLock);
end;
procedure TFpDebugDebugger.DecReleaseLock;
begin
dec(FReleaseLock);
if FReleaseNeeded and (FReleaseLock = 0) then
DoRelease;
end;
function TFpDebugDebugger.GetClassInstanceName(AnAddr: TDBGPtr): string;
var
VMTAddr: TDBGPtr;
@ -1613,19 +1635,24 @@ procedure TFpDebugDebugger.DebugLoopFinished;
var
Cont: boolean;
begin
{$ifdef DBG_FPDEBUG_VERBOSE}
DebugLn('DebugLoopFinished');
{$endif DBG_FPDEBUG_VERBOSE}
IncReleaseLock;
try
{$ifdef DBG_FPDEBUG_VERBOSE}
DebugLn('DebugLoopFinished');
{$endif DBG_FPDEBUG_VERBOSE}
FDbgController.SendEvents(Cont);
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
FQuickPause:=false;
FQuickPause:=false;
if Cont then
begin
SetState(dsRun);
StartDebugLoop;
end
if Cont then
begin
SetState(dsRun);
StartDebugLoop;
end
finally
DecReleaseLock;
end;
end;
procedure TFpDebugDebugger.QuickPause;
@ -1633,14 +1660,28 @@ begin
FQuickPause:=FDbgController.Pause;
end;
procedure TFpDebugDebugger.DoRelease;
begin
if FReleaseLock > 0 then begin
FReleaseNeeded := True;
exit;
end;
inherited DoRelease;
end;
procedure TFpDebugDebugger.DoState(const OldState: TDBGState);
begin
inherited DoState(OldState);
if not (State in [dsPause, dsInternalPause]) then
begin
FWatchEvalList.Clear;
FWatchAsyncQueued := False;
end;
IncReleaseLock;
try
inherited DoState(OldState);
if not (State in [dsPause, dsInternalPause]) then
begin
FWatchEvalList.Clear;
FWatchAsyncQueued := False;
end;
finally
DecReleaseLock;
end;
end;
{$ifdef linux}