paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-15 10:39:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 43834 #d5fa90b6d2, 43836-43837 #030f7410f2-#030f7410f2 from trunk:

Browse Source 
Debugger: Add timeout on kill
........
Debugger: Fixed and improved: Stop/Kill GDB when debugger stops
........
Debugger: Fixed and improved: Stop/Kill GDB when debugger stops
........

git-svn-id: branches/fixes_1_2@43847 -
This commit is contained in:
maxim 2014-01-29 23:09:40 +00:00
parent 32d44d838c
commit 561bd528db
2 changed files with 57 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
debugger/cmdlinedebugger.pp
View File

@ -73,6 +73,7 @@ type
procedure SetLineEnds(ALineEnds: TStringDynArray);
function ReadLineTimedOut: Boolean; virtual;
property ReadLineWasAbortedByNested: Boolean read FReadLineWasAbortedByNested;
procedure AbortReadLine;
public
constructor Create(const AExternalDebugger: String); override;
destructor Destroy; override;
@ -273,7 +274,7 @@ begin
except
Application.HandleException(Application);
end;
if Application.Terminated then Break;
if Application.Terminated or not DebugProcessRunning then Break;
// sleep a bit
Sleep(10);
end;
@ -565,6 +566,11 @@ begin
Result := FReadLineTimedOut;
end;
procedure TCmdLineDebugger.AbortReadLine;
begin
inc(FReadLineCallStamp);
end;
procedure TCmdLineDebugger.TestCmd(const ACommand: String);
begin
SendCmdLn(ACommand);

62
debugger/gdbmidebugger.pp
View File

@ -452,7 +452,7 @@ type
private
FCanKillNow, FDidKillNow: Boolean;
protected
function ProcessRunning(var AStoppedParams: String; out AResult: TGDBMIExecResult): Boolean;
function ProcessRunning(var AStoppedParams: String; out AResult: TGDBMIExecResult; ATimeOut: Integer = 0): Boolean;
function ParseBreakInsertError(var AText: String; out AnId: Integer): Boolean;
function ProcessStopped(const AParams: String; const AIgnoreSigIntState: Boolean): Boolean; virtual;
public
@ -687,7 +687,7 @@ type
function StartDebugging(AContinueCommand: TGDBMIExecCommandType): Boolean;
function StartDebugging(AContinueCommand: TGDBMIExecCommandType; AValues: array of const): Boolean;
function StartDebugging(AContinueCommand: TGDBMIDebuggerCommand = nil): Boolean;
procedure TerminateGDB;
protected
FNeedStateToIdle, FNeedReset: Boolean;
{$IFDEF MSWindows}
@ -823,6 +823,11 @@ resourcestring
gdbmiEventLogDebugOutput = 'Debug Output: %s';
gdbmiEventLogProcessExitNormally = 'Process Exit: normally';
gdbmiEventLogProcessExitCode = 'Process Exit: %s';
gdbmiFailedToTerminateGDBTitle = 'Error: GDB did not terminate';
gdbmiFailedToTerminateGDB = 'The IDE was unable to terminate the GDB process. '
+ 'This process may be left running outside the control of IDE.%0:s'
+ 'To ensure the process is noh affecting your System, you should locate it, '
+ 'and terminate it yourself.';
implementation
@ -2208,7 +2213,7 @@ end;
{ TGDBMIDebuggerCommandExecuteBase }
function TGDBMIDebuggerCommandExecuteBase.ProcessRunning(var AStoppedParams: String; out
AResult: TGDBMIExecResult): Boolean;
AResult: TGDBMIExecResult; ATimeOut: Integer): Boolean;
var
InLogWarning: Boolean;
@ -2410,9 +2415,18 @@ begin
InLogWarning := False;
FGotStopped := False;
FLogWarnings := '';
while FTheDebugger.DebugProcessRunning do
while FTheDebugger.DebugProcessRunning and not(FTheDebugger.State in [dsError, dsDestroying]) do
begin
S := FTheDebugger.ReadLine(50);
if ATimeOut > 0 then begin
S := FTheDebugger.ReadLine(ATimeOut);
if FTheDebugger.ReadLineTimedOut then begin
FProcessResultTimedOut := True;
break;
end;
end
else
S := FTheDebugger.ReadLine(50);
if (S = '(gdb) ') or
( (S = '') and FDidKillNow )
then
@ -2513,22 +2527,25 @@ begin
FTheDebugger.GDBPause(True);
FTheDebugger.CancelAllQueued; // before ProcessStopped
FDidKillNow := False; // allow ProcessRunning
Result := ProcessRunning(StoppedParams, R);
Result := ProcessRunning(StoppedParams, R, 1500);
if ProcessResultTimedOut then begin
// the uter Processrunning should stop, due to process no longer running
// the outer Processrunning should stop, due to process no longer running
FDidKillNow := True;
FTheDebugger.DebugProcess.Terminate(0);
FTheDebugger.TerminateGDB;
SetDebuggerState(dsStop);
FTheDebugger.CancelAllQueued; // stop queued new cmd
Result := True;
exit;
end;
FDidKillNow := True;
if StoppedParams <> ''
then ProcessStopped(StoppedParams, FTheDebugger.PauseWaitState = pwsInternal);
FTheDebugger.FPauseWaitState := pwsNone;
ExecuteCommand('kill', [cfNoThreadContext], 1500);
FTheDebugger.FCurrentStackFrameValid := False;
FTheDebugger.FCurrentThreadIdValid := False;
Result := ExecuteCommand('info program', [cfNoThreadContext], R);
Result := ExecuteCommand('info program', R, [cfNoThreadContext], 1500);
Result := Result and (Pos('not being run', R.Values) > 0);
if Result
then SetDebuggerState(dsStop);
@ -2859,7 +2876,7 @@ begin
if (not CmdRes)
or (Pos('not being run', R.Values) <= 0)
then begin
FTheDebugger.DebugProcess.Terminate(0);
FTheDebugger.TerminateGDB;
SetDebuggerState(dsError); // failed to stop
exit;
end;
@ -7283,7 +7300,7 @@ begin
FCurrentThreadId := 0;
FCurrentStackFrame := 0;
SendCmdLn('kill'); // try to kill the debugged process. bypass all queues.
DebugProcess.Terminate(0);
TerminateGDB;
end;
if (OldState in [dsPause, dsInternalPause]) and (State = dsRun)
then begin
@ -8229,7 +8246,7 @@ begin
then begin
// We don't know the state of the debugger,
// force a reinit. Let's hope this works.
DebugProcess.Terminate(0);
TerminateGDB;
Done;
Result := True;
Exit;
@ -8702,6 +8719,27 @@ begin
Cmd.ReleaseReference;
end;
procedure TGDBMIDebugger.TerminateGDB;
begin
AbortReadLine;
FPauseWaitState := pwsNone;
if DebugProcessRunning then begin
debugln(DBG_VERBOSE, ['TGDBMIDebugger.TerminateGDB ']);
if not DebugProcess.Terminate(0) then begin
if OnFeedback = nil then
MessageDlg(gdbmiFailedToTerminateGDBTitle,
Format(gdbmiFailedToTerminateGDB, [LineEnding]), mtError, [mbOK], 0)
else
OnFeedback(Self,
Format(gdbmiFailedToTerminateGDB, [LineEnding]),
'',
ftError, [frOk]
);
SetState(dsError);
end;
end;
end;
{$IFDEF DBG_ENABLE_TERMINAL}
procedure TGDBMIDebugger.ProcessWhileWaitForHandles;
begin