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

LLDB Debugger: fix debugger done and thread terminate

Browse Source 
git-svn-id: trunk@58362 -
This commit is contained in:
martin 2018-06-20 21:34:30 +00:00
parent 0f3ba9ba56
commit 34f1c7d389
2 changed files with 19 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
components/lazdebuggers/cmdlinedebuggerbase/debugprocess.pas
View File

@ -318,6 +318,9 @@ begin
if FReadThread <> nil then begin
FReadThread.Terminate;
FinishedReadingOutput;
debugln(['DESTROY thread destroying']);
FreeAndNil(FReadThread);
debugln(['DESTROY thread destroyed']);
end;
{$ENDIF}
Result := inherited Terminate(AExitCode);
@ -479,6 +482,12 @@ destructor TDebugProcess.Destroy;
begin
if DebugProcessRunning then
StopDebugProcess; // calls FDbgProcess.Release;
try
FDbgProcess.Destroy;
except
on E: Exception do DebugLn(DBG_WARNINGS, 'Exception while freeing debugger: ', E.Message);
end;
inherited Destroy;
end;
@ -486,11 +495,11 @@ function TDebugProcess.CreateDebugProcess(const AOptions: String;
AnEnvironment: TStrings): Boolean;
begin
Result := False;
if FDbgProcess = nil
then begin
FDbgProcess := TDebugAsyncProcess.Create(nil);
try
FDbgProcess.ParseCmdLine(FExternalDebugger + ' ' + AOptions);
FDbgProcess.Options:= [poUsePipes, poNoConsole, poStdErrToOutPut, poNewProcessGroup];
{$if defined(windows) and not defined(wince)}
// under win9x and winMe should be created with console,
@ -499,13 +508,14 @@ begin
FDbgProcess.Options:= [poUsePipes, poNewConsole, poStdErrToOutPut, poNewProcessGroup];
{$endif windows}
FDbgProcess.ShowWindow := swoNone;
FDbgProcess.Environment:= AnEnvironment;
except
FreeAndNil(FDbgProcess);
end;
end;
if FDbgProcess = nil then exit;
FDbgProcess.ParseCmdLine(FExternalDebugger + ' ' + AOptions);
FDbgProcess.Environment:= AnEnvironment;
FDbgProcess.OnReadData := @DoReadData;
FDbgProcess.OnTerminate := @DoTerminate;
@ -531,12 +541,6 @@ debugln(['TDebugProcess.StopDebugProcess FDbgProcess = nil ',FDbgProcess = nil])
if FDbgProcess = nil then exit;
FDbgProcess.Terminate(0);
try
FDbgProcess.Destroy;
except
on E: Exception do DebugLn(DBG_WARNINGS, 'Exception while freeing debugger: ', E.Message);
end;
FDbgProcess := nil;
end;
procedure TDebugProcess.SendCmdLn(const ACommand: String);

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

@ -1268,8 +1268,14 @@ procedure TLldbDebugger.Done;
begin
DebugLnEnter('!!! TLldbDebugger.Done;');
// TODO: cancel all commands
FDebugInstructionQueue.OnDebuggerTerminated := nil;
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;
inherited Done;
DebugLnExit('!!! TLldbDebugger.Done;');
end;