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

LazDebugger(Fp)Lldb: terminate debugger, when entering error state

Browse Source 
git-svn-id: trunk@60642 -
This commit is contained in:
martin 2019-03-10 02:54:05 +00:00
parent 0254bf470d
commit 6d0a2c7637
2 changed files with 26 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.gitattributes vendored
View File

@ -6111,6 +6111,7 @@ docs/xml/lcl/clipbrd.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/colorbox.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/comboex.xml svneol=native#text/plain
docs/xml/lcl/comctrls.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/comctrls/TrackBarEx.pas svneol=native#text/pascal
docs/xml/lcl/comctrls/ttoolbutton.pas svneol=native#text/plain
docs/xml/lcl/comctrls/ttreenode_data.pas svneol=native#text/plain
docs/xml/lcl/commctrl.xml svneol=LF#text/xml eol=lf
@ -6137,6 +6138,7 @@ docs/xml/lcl/dirsel.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/dynamicarray/tarrayexample.pas svneol=native#text/plain
docs/xml/lcl/editbtn.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/extctrls.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/extctrls/radiobutton.pas svneol=native#text/pascal
docs/xml/lcl/extctrls/statusbar.pas svneol=native#text/plain
docs/xml/lcl/extdlgs.xml svneol=LF#text/xml eol=lf
docs/xml/lcl/extgraphics.xml svneol=LF#text/xml eol=lf
@ -6994,6 +6996,7 @@ examples/translation/unit2.pas svneol=native#text/pascal
examples/trayicon/createbundle.sh svneol=native#text/plain
examples/trayicon/frmtest.dfm -text
examples/trayicon/frmtest.lfm -text
examples/trayicon/frmtest.pas svneol=native#text/pascal
examples/trayicon/icon.ico -text
examples/trayicon/wndtray.dpr -text
examples/trayicon/wndtray.lpi -text
@ -8968,6 +8971,7 @@ images/splash_logo.png -text svneol=unset#image/png
images/splash_logo.res -text
images/splash_logo.xpm -text svneol=native#image/x-xpixmap
images/splash_source/cheetah.jpg -text svneol=unset#image/jpeg
images/splash_source/cheetah.txt svneol=native#text/pascal
images/splash_source/paw.png -text svneol=unset#image/png
images/states/quickfix.png -text svneol=unset#image/png
images/states/quickfix_150.png -text svneol=unset#image/png

30
components/lazdebuggers/lazdebuggerlldb/lldbdebugger.pas
View File

@ -313,6 +313,7 @@ type
function LldbPause: Boolean;
function LldbEvaluate(const AExpression: String; EvalFlags: TDBGEvaluateFlags; ACallback: TDBGEvaluateResultCallback): Boolean;
function LldbEnvironment(const AVariable: String; const ASet: Boolean): Boolean;
procedure TerminateLldb; // Kills external debugger
protected
procedure DoBeforeLaunch; virtual;
procedure DoBeginReceivingLines(Sender: TObject);
@ -320,7 +321,7 @@ type
procedure LockRelease; override;
procedure UnlockRelease; override;
procedure QueueCommand(const ACommand: TLldbDebuggerCommand);
//procedure DoState(const OldState: TDBGState); override;
procedure DoState(const OldState: TDBGState); override;
//procedure DoBeforeState(const OldState: TDBGState); override;
procedure SetErrorState(const AMsg: String; const AInfo: String = '');
function DoExceptionHit(AExcClass, AExcMsg: String): Boolean;
@ -2738,6 +2739,18 @@ begin
Result := True;
end;
procedure TLldbDebugger.TerminateLldb;
begin
if FDebugProcess.DebugProcessRunning then begin
FDebugProcess.SendCmdLn('process kill');
FDebugProcess.SendCmdLn('quit');
Sleep(100);
end;
FDebugInstructionQueue.OnDebuggerTerminated := nil; // TODO: use a flag to prevent this
FDebugProcess.StopDebugProcess;
FDebugInstructionQueue.OnDebuggerTerminated := @DoCmdLineDebuggerTerminated;
end;
procedure TLldbDebugger.DoBeforeLaunch;
begin
//
@ -2763,6 +2776,13 @@ begin
inherited SetErrorState(AMsg, AInfo);
end;
procedure TLldbDebugger.DoState(const OldState: TDBGState);
begin
inherited DoState(OldState);
if (State = dsError) then
TerminateLldb;
end;
function TLldbDebugger.DoExceptionHit(AExcClass, AExcMsg: String): Boolean;
begin
if Assigned(EventLogHandler) then
@ -2981,14 +3001,8 @@ procedure TLldbDebugger.Done;
begin
DebugLnEnter('!!! TLldbDebugger.Done;');
// TODO: cancel all commands
if FDebugProcess.DebugProcessRunning then begin
FDebugProcess.SendCmdLn('process kill');
FDebugProcess.SendCmdLn('quit');
end;
FDebugInstructionQueue.OnDebuggerTerminated := nil; // TODO: use a flag to prevent this
FDebugProcess.StopDebugProcess;
FDebugInstructionQueue.OnDebuggerTerminated := @DoCmdLineDebuggerTerminated;
TerminateLldb;
inherited Done;
DebugLnExit('!!! TLldbDebugger.Done;');
end;