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